كود إخلاء شطر مصفوفة الإرتباط

[محمد طاهر عرفه]

عادة ما تتضمن نتائج التحاليل الاحصائية مصفوفة الارتباط التي تبين درجة الارتباط بين  المتغيرات التي نجدها ممثلة فى رؤوس الأعمدة و الصفوف

و تكون هذه المصفوفة صعبة القراءة اذا تركت دون تنقيح ، و أحد خطوات التنقيح المتعارف عليها هو مسح محتوى احد شطري المصفوفة لتكون اكثر وضوحا

حيث ان الشطران يقدمات نفس المعلومة نماما فمعامل الارتباط بين س و ص = 0.5 يعني تماما ان معامل الارتباط بين ص و س = 0.5 و بالتالي وجود شطران للمصفوفة لا يضيف معلومة

و بالطبع هناك من يحبذ ترك الشطرين ، و انا مع الرأي الأول لذا أعددت هذا الكود

و للتوضيح هذا هو الوضع قبل حذف احد الشطرين

و هذا بعد الحذف

و للحصول على ذلك قم باختيار مساحة البيانات كاملة دون رؤوس الصفوف و الاعمدة و شغل الكود التالي

Sub Correlation_Clear()


'
' delelte matrix upper half & also diagonal

Application.ScreenUpdating = False

 Dim myrow As Long, origraw As Long
 Dim mycol As Long, oricol As Long
  
  myrow = Selection.Rows.Count
  origraw = myrow
    mycol = Selection.Columns.Count
  oricol = myrow

ActiveCell.Select
'MsgBox MyRow

For i = 0 To myrow

For j = i + 1 To mycol

ActiveCell.Offset(i, j) = ""
 
   Application.StatusBar = "Clearing ...." & _
   Format(i / origraw, "0.0%") & "       Please Wait......."
   
Next j
Next i


For i = 0 To myrow - 1


    With ActiveCell.Offset(i, i).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
    End With
    With ActiveCell.Offset(i, i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
   
Next i


    Application.ScreenUpdating = True
    Application.StatusBar = False
    

End Sub

مرقق الملف للتجربة

 

Clear-correlation.xlsm

موضوع مرتبط يمكن الاستفادة منه فى الخطوة التالية للتجهيز و هي تحويل المصفوفة لجدول مقارن ، لمن أراد

كود لتحويل مصفوفة إلى عمود واحد رأسي