ترتيب البيانات من خلال 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

[mahmoud nasr alhasany]

وجدت الحل بحمدلله

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

    ' نسخ البيانات من 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

    ' تحديد عمود الفرز بناءً على ComboBox
    sortColumn = ComboBox1.ListIndex

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

    ' الفرز باستخدام Bubble Sort
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If sortOrder Then
                ' ترتيب تنازلي
                If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then
                    If CDbl(arr(i, sortColumn)) > CDbl(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
                Else
                    If UCase(arr(i, sortColumn)) > UCase(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
                End If
            Else
                ' ترتيب تصاعدي
          If IsNumeric(arr(i, sortColumn)) Or IsNumeric(arr(j, sortColumn)) Then
                    If CDbl(arr(i, sortColumn)) < CDbl(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
                Else
                    If UCase(arr(i, sortColumn)) < UCase(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
                End If
            End If