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

[أبو قاسم]

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

فرز.zip

[ياسر خليل أبو البراء]

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

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

[أبو قاسم]

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

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

[أبو قاسم]

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

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

Least And Most Occurence.rar

[ياسر خليل أبو البراء]

أخي الكريم

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

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

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

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

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

تقبل تحياتي

 

[أبو قاسم]

جزاك الله الف خير صراحة شي جميل  ويعطيك الف عافية ابداع وتسلم يداك