ماتریس متقارن

[generalsamad]

با سلام
با ترکیب این دو فرمول میتوان یک ماتریس متقارن ساخت
اول داده های قطر بالا مثلثی را وارد میکنیم سپس برای قطر پائین مثلثی از این فرمول استفاده میکنیم
دقت کنید برای این فرمول باید اولین خانه ماتریس جائی از شیت قرار بگیره که شماره سطر و ستون یکی باشند
بطور مثال اگه بخواهیم اولین خانه ماتریس در سطر 1 ایجاد کنیم شماره ستون هم باید 1 باشه که در کل آدرسش میشه a1
اگه بخواهیم اولین خانه ماتریس در سطر 1 ایجاد کنیم شماره ستون هم باید 1 باشه که در کل آدرسش میشه b2
اگه بخواهیم اولین خانه ماتریس در سطر 1 ایجاد کنیم شماره ستون هم باید 1 باشه که در کل آدرسش میشه c3

البته برای این فرمول اینطوره که میتونیم با کم یا زیاد کردن پارامترها به خواسته خود برسیم بدون اینکه موارد بالا رو رعایت کنیم

اینم فرمول


=indirect(address(column();row()))


کافیه این فرمول رو برای کل قطر پائینی نوشت
در مورد توضیح کد بالا تنها نکته ای که داره اینه آرگومان اول فرمول آدرس مربوط به سطر هست که من توی فرمول شماره ستون رو نوشتم و آرگومان دوم شماره ستون هست که شماره سطر رو نوشتم
این عمل کار تقارن رو انجام میده

فایل ضمیمه گردید

از دوستانی که Vba کار میکنند اگه زحمت کد نویسیش رو انجام بدید و توی همین پست قرار بدید ممنون میشم
کد طوری باشه که کاربر فقط قطر بالا مثلثی رو وارد کنه که نیازی نباشه فرمول نویسی رو انجام بده
شاید بعد ماتریس هم تغییر پیدا کنه این هم مد نظر باشه

با تشکر

[abootorab]

با درود
ضمن تشکر از جناب آقای generalsamad در تکمیل آموزش و بنا به در خواست ایشان کدنویسی vba ماتریس متقارن به همراه فایل نمونه تقدیم دوستان میگردد. امیدوارم برای دوستان مفید واقع شود.

توضیح عمکرد کد:
جهت ایجاد یک ماتریس متقارن کافیه در یکی از سلولها دوبارکلیک کنید، پس از آن از شما پرسیده میشود طول قطر ماتریس چه تعداد باشد که با وارد کردن طول قطر، ماتریس متقارن خالی به ابعاد مورد نظر تولید میشود. سپس شما در هر سلول از این ماتریس که مقداری وارد کنید در سلول متقارن آن، مقدار مربوطه ایجاد خواهد شد ضمن اینکه محدودیتی در وارد کردن کدام سمت مثلثی ماتریس ندارید، یعنی در هرسمت که مقدار وارد شد در سمت متقارن مثلث مقدار شما ایجاد میشود.
همچنین با دوبارکلیک مجدد در یک سلول شما می توانید ماتریس قبلی را کاملا حذف و ماتریس جدید با ابعاد دلخواه ایجاد کنید و در صورتیکه بخواهید بدون ایجاد ماتریس جدید ماتریس قبلی را حذف کنید پس از دوبارکلیلک در یک سلول و ظاهر شدن پرسش طول قطر ماتریس، مقدار صفر را وارد و اینتر کنید.

البته دوستان بسته به نیاز خود می توانند کد زیر را تغییر و استفاده کنند.


Public Src As Range, Mtx As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
Dim Vtr As Integer
p1 = "Please enter the dimension of Matrix:"
p2 = "(Enter '0' to erase Matrix)"
p = p1 + Chr(13) + Chr(13) + p2
t = "Enter Dimension"
ib = InputBox(p, t, 7)

If ib = "" Then Exit Sub Else Vtr = Val(ib)
If Vtr < 2 And Vtr <> 0 Then
MsgBox "Dimension of Matrix Not less than 2!", vbExclamation, "Error"
Cancel = True
Exit Sub
End If

If Not Mtx Is Nothing Then
Mtx.Clear
If Vtr = 0 Then Cancel = True: Exit Sub
End If

Set Mtx = Range(Target.Address & ":" & Target.Offset(Vtr - 1, Vtr - 1).Address)
Set Src = Target

Application.EnableEvents = False
Application.ScreenUpdating = False
Mtx.Clear

For i = Src.Row To Src.Row + Mtx.Rows.Count - 1
For j = Src.Column To Src.Column + Mtx.Columns.Count - 1
If i - Src.Row = j - Src.Column Then
Cells(i, j).Interior.Color = 15921906
ElseIf i - Src.Row < j - Src.Column Then
Cells(i, j).Interior.Color = 15849925
Else
Cells(i, j).Interior.Color = 14281213
End If
Next j
Next i

Mtx.Borders.LineStyle = xlContinuous
Application.EnableEvents = True
Application.ScreenUpdating = True
Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Vtr As Integer
Vtr = Mtx.Columns.Count

If Target.Row < Src.Row Or Target.Row >= Src.Row + Vtr Then
Target.Interior.Pattern = xlNone
Exit Sub
End If
If Target.Column < Src.Column Or Target.Column >= Src.Column + Vtr Then
Target.Interior.Pattern = xlNone
Exit Sub
End If

Application.EnableEvents = False
Src.Offset(Target.Column - Src.Column, Target.Row - Src.Row).Value = Target.Value
Application.EnableEvents = True
End Sub


هرکاری کردم فایل با پسوند xlsm نشد آپ کنم و اجبارا اون رو به rar تبدیل و آپ کردم!!!!

[s.cheraghi]

سلام
با تشکر از دوستان
برای اینکه بتونین ماتریس متقارن را هر جای شیت داشته باشین از فایل زیر میتونین استفاده کنین.

[Darya15]

با سلام می خواستم بدونم کاربرد این ماتریکسها چیه و کجا به درد میخوره؟

[generalsamad]

با سلام
این یک مسئله ریاضی هستش و شاید در ماتریسهای مختلف ، یا محاسبات مختلف کاربرد داشته باشه

هدف از این آموزش آشنائی با ترکیب چند فرمول جستجو بوده که شاید مسئله ای داشته باشیم یا بخواهیم برنامه ای (بازی) بسازیم که چنین کاری رو انجام بده