اذهب الي المحتوي
أوفيسنا
محمد طاهر

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

Recommended Posts

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

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

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

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

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

image.png.0a3d24bf9410e5937106a429da0dced7.png

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

image.png.15a8314d304bd71869005dc6950ef542.png

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


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

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

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

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • محتوي مشابه

    • بواسطه محمد طاهر
      اعرض الملف كود لتحويل مصفوفة إلى عمود واحد رأسي
      اجتجت الي تجويل البيانات فى مصفوفات الى عمود واجد رأسي ، فقمت باعداد هذا الملف
      و هذا هو الكود
      و يجب تظليل (اختيار) المصفوفة المطلوب تحويلها لعمود قبل تشغيل الكور
      اختار المصفوفة ثم اضغط على الزر
      ملاحظة : بفضل تجميل الاصدار الاخير الذي يظهر اسفل الصفحة لانه به ميزة اضافية 
      Sub MakeOneColumn() Dim Myrows As Integer, Mycols As Integer Myrows = Selection.Rows.Count Mycols = Selection.Columns.Count With ActiveCell For i = 0 To Mycols '6 For j = 0 To Myrows '3 .Offset(Myrows * (i) + j) = .Offset(j, i) Next j Next i End With End Sub  
      الكود المعدل فى الاصدار التاني ، 
      للتشغيل اختار البيانات دون رؤس الأعمدةو الصفوف
      Sub MakeOneColumn() Dim Myrows As Integer, Mycols As Integer Myrows = Selection.Rows.Count Mycols = Selection.Columns.Count With ActiveCell For i = 0 To Mycols - 1 For j = 0 To Myrows - 1 ' record matrix value .Offset(Myrows * (i) + Myrows + 1 + j, 1) = .Offset(j, i) ' record Row .Offset(Myrows * (i) + Myrows + 1 + j, -1) = .Offset(j, -1) ' record Col .Offset(Myrows * (i) + Myrows + 1 + j, 0) = .Offset(-1, i) Next j Next i End With End Sub  
      صاحب الملف محمد طاهر تمت الاضافه 10 يول, 2019 الاقسام قسم الإكسيل  
  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×
×
  • اضف...