تغعيل تاريخ البداية والنهاية

[أبو قاسم]

يوجد شيت  بة فورم يوضح كم عدد مرات تكرار الاسم ولكن محتاج تفعيل  تاريخ بداية الاحصاء وتاريخ نهاية الاحصاء  وتفعيل زر الفورم لكي يفتح من اي مكان في الاكسل ومن اي صفحة مثل شيت 2

احصاء بين تاريخين.rar

[الـعيدروس]

السلام عليكم

استبدل كود  CommandButton1_Click  بالتالي

Private Sub CommandButton1_Click()
Dim D As Date
Dim D1 As Date
Dim Ar, Tx$, y, I, T$, II&, Lr&, V
Dim Rng As Range, Rn As Range
Dim My_Rn As Range
Dim Am
Dim Sh As Worksheet
Set Sh = Sheets("Sheet1")
If Not IsDate(TextBox1) Then MsgBox "حقل تاريخ اعد كتابة التاريخ": TextBox1.SetFocus: Exit Sub
If Not IsDate(TextBox2) Then MsgBox "حقل تاريخ اعد كتابة التاريخ": TextBox2.SetFocus: Exit Sub
D = DateSerial(Year(TextBox1), Month(TextBox1), Day(TextBox1))
D1 = DateSerial(Year(TextBox2), Month(TextBox2), Day(TextBox2))
Lr = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
II = 2
Set Rng = Sh.Range("c2:c" & Lr)
With CreateObject("scripting.dictionary")
For R = 2 To Lr
  If IsDate(Sh.Cells(R, 6)) Then
  V = DateSerial(Year(Sh.Cells(R, 6)), Month(Sh.Cells(R, 6)), Day(Sh.Cells(R, 6)))
  If V >= D And V <= D1 Then
      Set Rn = Sh.Range("C" & R)
      Tx = Sh.Cells(R, 3)
      If Not Rn Is Nothing Then
        If My_Rn Is Nothing Then Set My_Rn = Rn Else Set My_Rn = Union(My_Rn, Rn)
      End If
      y = .Item(Tx)
  End If
  End If
Next R
  Ar = Split(Join(.Keys, ","), ",")
For I = LBound(Ar) To UBound(Ar)
    If Application.CountIf(My_Rn, Ar(I)) > 0 Then
       T = T & Ar(I) & "      :   " & " عدد التكرار   (    " & Application.CountIf(My_Rn, Ar(I)) & "   ) " & vbNewLine
    End If
Next
With UserForm2
    .ListBox1.List = Application.Transpose(Split(T, vbNewLine))
End With
Set Rn = Nothing: Set My_Rn = Nothing: Set Rng = Nothing
End With
End Sub

 

تحياتي

[أبو قاسم]

لك كل الشكر والتقدير مبدع صراحة لاتوجد كلمات توفيك حقك