فرز البيانات في الليست بوكس

**أبو قاسم** · مارس 19, 2016

ارجو المساعدة بفرز البيانات في اللست بوكس الاسم الاكثر عدد يكون الاعلى والاقل عدد يكون الاسفل ولو يكون يلون بلون معين يكون الافضل

فرز.zip

ياسر خليل أبو البراء · مارس 19, 2016

ماذا تقصد أخي الكريم بلون معين ؟ هل تريد تلوين كل سطر بالليست بوكس بلون معين أم تلوين الأعلى تكرراراً فقط ...

ما هو مصدر الكود أخي الكريم ابو قاسم ..يبدو لي أنه من أعمال الأخ العزيز العيدروس !! هل كلامي صحيح؟

**أبو قاسم** · مارس 19, 2016

كلام صحيح بالكامل نفس النقاط التي ذكرت والكود هو كود الاستاذ العيدروس

تلوين اعلاء تكرارا

**أبو قاسم** · مارس 20, 2016

تم تغيير الفكرة لك يسهل ايجاد الحل وجزاة الله خير من ساعدنا

يوجد توضيح في الفورم فرز

Least And Most Occurence.rar

ياسر خليل أبو البراء · مارس 21, 2016

أخي الكريم

لا أحب إرفاق أكثر من ملف مختلف في موضوع واحد .. لأنه بهذا الشكل قد تغيرت الفكرة وتغير الطلب تماماً ..

عملت على الملف الأول فقط .. إذا أردت أن تعمل على الملف الثاني فاطرح موضوع مستقل بذلك الطلب ..

إليك الكود التالي ..ضع الكود في حدث الفورم واحذف الكود القديم أولاً

Private Sub CommandButton1_Click()
    Dim cMis As New Collection, D1 As Date, D2 As Date, N&, R&, V, VD, VN

    If Not IsDate(TextBox1) Then MsgBox "Enter Start Date": TextBox1.SetFocus: Exit Sub
    If Not IsDate(TextBox2) Then MsgBox "Enter End Date": TextBox2.SetFocus: Exit Sub

    UserForm2.ListBox1.Clear
    D1 = CDate(TextBox1)
    D2 = CDate(TextBox2)

    With Sheet1.Cells(1).CurrentRegion.Columns
        VN = .Item(1).Value
        VD = .Item(6).Value
    End With

    On Error Resume Next
    For R = 1 To UBound(VN)
        If VarType(VD(R, 1)) = vbDate Then
            If VD(R, 1) >= D1 And VD(R, 1) <= D2 Then
                Err.Clear
                cMis.Add Array(VN(R, 1), 1), VN(R, 1)

                If Err.Number = 457 Then
                    V = cMis(VN(R, 1))
                    V(1) = V(1) + 1
                    cMis.Remove V(0)

                    For N = 1 To cMis.Count
                        If V(1) > cMis(N)(1) Then cMis.Add V, V(0), N: Exit For
                    Next N

                    If N > cMis.Count Then cMis.Add V, V(0)
                End If
            End If
        End If
    Next R
    On Error GoTo 0

    If cMis.Count Then
        For Each V In cMis
            UserForm2.ListBox1.AddItem V(0) & " :  عدد المهمات ( " & V(1) & " )"
        Next V
        Set cMis = New Collection
    Else
        MsgBox "No Match !"
    End If

    Set cMis = Nothing
End Sub

Private Sub CommandButton2_Click()
    Me.TextBox1.Value = Format(Date, "dd/mm/yyyy")
    Me.TextBox2.Value = Format(Date, "dd/mm/yyyy")
End Sub

أرجو أن يكون المطلوب

تقبل تحياتي