يوجد فورم محتاج اكبر اسم مكرر واقل اسم تكرر

[أبو قاسم]

السلام عليكم ورحمة الله وبركاتة 

محتاج اظهار اكثر اسم تكرارا في المربع الاول وكم عدد مرات التكرار 

وايضا اظهار اقل اسم تكرار في المربع الثاني وكم عدد مرات التكرار 

يوجد مثال في الملفين المرفقين

New WinRAR archive.rar

[سليم حاصبيا]

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

Least And Most Occurence salim.rar

[أبو قاسم]

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

[أبو قاسم]

للرفع

[سليم حاصبيا]

تفضل يا صديقي

 

Least And Most Occurence salim.rar

[أبو قاسم]

1 ساعه مضت, سليم حاصبيا said:

تفضل يا صديقي

 

Least And Most Occurence salim.rar

جزيت خيرا  محتاج تطبيق الموضوع على الفورم المرفق في الملف الجديد 

فرز.zip

[سليم حاصبيا]

الملف الجديد لا يمكن تنزيله لا اعرف السبب

جرب تحميله مرة اخرى 

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

أخي الكريم أبو قاسم

أخبرتك أن كثرة الملفات المرفقة في الموضوع تحدث ارتباك عند الأعضاء ونصحتك أن ترفق ملف واحد فقط للعمل عليه لتجد المساعدة المناسبة ولكي لا تضيع وقت إخوانك ..

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

وتوضيح المطلوب بإرفاق شكل النتائج المتوقعة كأن تقول أنه في تكست بوكس رقم كذا سيكون الناتج كذا ... وهكذا لتتضح صورة الطلب بشكل أوضح

تقبل تحياتي

 

[أبو قاسم]

تم الرفع من جديد

 

أشكركم على سعة صدورهم

فرز.zip

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

أخي الكريم أبو قاسم

قم بتعديل مسميات التكس بوكس لأن فيه تكست بوكس مفقود .. التكست بوكس رقم 6 لديك غيره ليكون رقم 5 (حيث الرقم 5 مفقود) والتكست بوكس رقم 7 خليه 6

وجرب الكود التالي عله يكون المطلوب

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
    
    For N = 3 To 6: Me.Controls("TextBox" & N).Value = "": Next
    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
        N = 0
        For Each V In cMis
            UserForm2.ListBox1.AddItem V(0) & " :  عدد المهمات ( " & V(1) & " )"
            N = N + 1
            Select Case N
            Case 1: TextBox3.Value = V(0): TextBox5.Value = V(1)
            Case cMis.Count: If N > 1 Then TextBox4.Value = V(0): TextBox6.Value = V(1)
            End Select
        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(Range("F2"), "dd/mm/yyyy")
    Me.TextBox2.Value = Format(Range("F25"), "dd/mm/yyyy")
End Sub

تقبل تحياتي