ترتيب البيانات من خلال Combobox1 , Checkbox1

[mahmoud nasr alhasany]

السلام عليكم ورحمة الله وبركاتة رجاء مساعدتى

فى comobobx1 يوجد خيارين "كود "و "اسم العميل" كود مرتبط بالعمود الاول واسم العميل مرتبط بالعمود الثانى فى listbox1  ملحوظة عندما اختار كلمة كود فى combobox يقوم بالترتيب تنازلى او تصاعدى من خلال Checkbox انه يعمل جيدا ولاكن عند اقوم  باختار كلمة اسم عميل فى combobox  لا يقوم بالترتيب تنازلى او تصاعدى من بواسطة Checkbox                                                                                  عندما اضغط على  امر    Private Sub CommandButton8_Click()

 

 

Private Sub CommandButton8_Click()
    Dim arr() As Variant
    Dim i As Long, j As Long, temp As Variant
    Dim sortColumn As Integer
    Dim sortOrder As Boolean


 ' التأكد من وجود بيانات في ListBox
    If ListBox1.ListCount = 0 Then
        MsgBox "لا توجد بيانات لفرزها", vbExclamation
        Exit Sub
    End If

    ' تحديد عمود الفرز بناءً على ComboBox
    sortColumn = ComboBox1.ListIndex + 1 ' نفترض أن الفهرس يبدأ من 0

    ' تحديد اتجاه الفرز بناءً على CheckBox
    sortOrder = CheckBox1.Value

    ' نسخ البيانات من ListBox إلى المصفوفة
    ReDim arr(ListBox1.ListCount - 1, ListBox1.ColumnCount - 1)
    For i = 0 To ListBox1.ListCount - 1
        For j = 0 To ListBox1.ColumnCount - 1
            arr(i, j) = ListBox1.List(i, j)
        Next j
    Next i

    ' الفرز باستخدام Bubble Sort
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If sortOrder And arr(i, sortColumn) > arr(j, sortColumn) Then ' ترتيب تنازلي
                ' تبادل السجلين بالكامل
                For k = LBound(arr, 2) To UBound(arr, 2)
                    temp = arr(i, k)
                    arr(i, k) = arr(j, k)
                    arr(j, k) = temp
                Next k
            ElseIf Not sortOrder And arr(i, sortColumn) < arr(j, sortColumn) Then ' ترتيب تصاعدي
                ' تبادل السجلين بالكامل
                For k = LBound(arr, 2) To UBound(arr, 2)
                    temp = arr(i, k)
                    arr(i, k) = arr(j, k)
                    arr(j, k) = temp
                Next k
            End If
        Next j
    Next i

    ' مسح البيانات القديمة وإضافة البيانات الجديدة
    ListBox1.Clear
    For i = LBound(arr) To UBound(arr)
        ListBox1.AddItem
        For j = LBound(arr, 2) To UBound(arr, 2)
         '   ListBox1.List(i, j - 1) = arr(i, j) ' نبدأ من الصفر في ListBox
        ListBox1.List(i, j) = arr(i, j)
        Next j
    Next i
  
  With ListBox1
    .Font.Size = 12 ' تغيير حجم الخط إلى 12
    .ColumnCount = 2
    .ColumnWidths = "80;120"
   ' .Font.Color = vbBlue ' تغيير لون الخط إلى الأزرق
     .BackColor = RGB(255, 255, 204) ' تغيير لون الخلفية إلى أصفر فاتح
End With

End Sub

شاشة عميل بحث.xlsm