ضبط كود بحث بين تاريخين وبشرط وعرض النتائج فى ليست بوكس

[مهند محسن]

السلام عليكم اساتذى وخبرائى

رجاءا مساعدتى فى ضبط وتعديل هذا الكود بحيث يقوم بعرض نتائج البحث بين تاريخين وفى وجود شرط معهما فى الليست بوكس وجزاكم الله جميعا كل خير

Private Sub CommandButton1_Click()
 Dim tarih1, tarih2: Dim ara As Range, LastRow As Long
    Dim s1 As Worksheet
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Set s1 = Worksheets("P-1")
    If TextBox1.Value = "" Or TextBox2.Value = "" Then
    MsgBox "You need to add the beginning and end dates", vbCritical, ""
    Exit Sub
    End If
    If ComboBox1.Value = "" Then
    MsgBox "Please choose a product from drop-down list", vbDefaultButton1, ""
    Exit Sub
    End If
       Call uzat
    tarih1 = CDate(TextBox1.Value)
    tarih2 = CDate(TextBox2.Value)
    ListBox1.Clear
    ListBox1.ColumnCount = 5
    ListBox1.ColumnWidths = "30;140;80;70;80"
        LastRow = s1.Range("C" & Rows.Count).End(xlUp).Row
    For Each ara In s1.Range("C2:C" & LastRow)
   If ara >= tarih1 And _
    ara <= tarih2 And _
    ara.Offset(0, 1) = CStr(ComboBox1.Text) Then
ListBox1.AddItem
           ListBox1.List(ListBox1.ListCount - 1, 1) = VBA.Format(ara, "dd.mm.yyyy")
            ListBox1.List(ListBox1.ListCount - 1, -1) = ara.Offset(0, -2)
            ListBox1.List(ListBox1.ListCount - 1, 0) = ara.Offset(0, -1)
            ListBox1.List(ListBox1.ListCount - 1, 2) = ara.Offset(0, 3)
            ListBox1.List(ListBox1.ListCount - 1, 3) = ara.Offset(0, 4)
                                         End If
 Next ara
   Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.EnableEvents = True
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
TextBox1 = Empty: TextBox2 = Empty: ComboBox1 = Empty: ListBox1.Clear
UserForm1.Height = 107
End Sub

Sub uzat()
Dim x, d, yuk, mak As Integer
For x = 1 To 20
DoEvents
If E = 0 Then
d = d + 10
yuk = 242
End If
UserForm1.Height = yuk + d
Next
End Sub
Private Sub CommandButton4_Click()
Dim sat As Long, sut As Integer, s2 As Worksheet
Sheets("P-2").Range("A:E").ClearContents
    If ListBox1.ListCount = 0 Then
     MsgBox "There Aren't Data", vbExclamation, ""
     Exit Sub
    End If
    Set s2 = Sheets("P-2")
    sat = ListBox1.ListCount
    sut = ListBox1.ColumnCount
    s2.Range(s2.Cells(1, 1), s2.Cells(sat, sut)) = ListBox1.List
    MsgBox "Data Were Copied."
 End Sub

Private Sub Date1_Click()
Call SF_DatePick.DatePickinCtl(Me.TextBox1)
End Sub
Private Sub Date2_Click()
Call SF_DatePick.DatePickinCtl(Me.TextBox2)
End Sub
Private Sub UserForm_Initialize()
Dim x, a, b As Long, c As Variant
Application.ScreenUpdating = False
'Unique Records
For x = 3 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & x), Cells(x, 1)) = 1 Then
ComboBox1.AddItem Cells(x, 1).Value
End If
Next
'Alphabetic Order
For a = 0 To ComboBox1.ListCount - 1
  For b = a To ComboBox1.ListCount - 1
        If ComboBox1.List(b) < ComboBox1.List(a) Then
c = ComboBox1.List(a)
    ComboBox1.List(a) = ComboBox1.List(b)
    ComboBox1.List(b) = c
       End If
  Next
  Next
        
UserForm1.Height = 107
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_Activate()
    UserForm1.Left = 100
    UserForm1.Top = 20
End Sub

 

Search Between 2 Dates.xlsm

[عبدللرحيم]

نفضل يا أخى مهند محسن

 

OKK_Search Between 2 Dates.xlsm

[مهند محسن]

بارك الله فيك استاذى الكريم احسنت وهو المطلوب جعله الله فى ميزان حسناتك

[مهند محسن]

السلام عليكم استاذى عبد الرحيم هناك مشكلة صغيرة بالنسبة للبيانات والأعمدة التى تظهر بالليست بوكس -فالعمود الأول الذى به كود العامل غير موجود بالليست بوكس فرجاءا بعد اذن حضرتك لو ممكن اظهاره

[عبدللرحيم]

نفضل يا أخى 

OKK_Search Between 2 Dates.xlsm

[مهند محسن]

شكرا لك استاذى الكريم يعجز لسانى عن شكر حضرتك جزاك الله كل خير

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

اعتذر من حضرتك كثيرا على تعبك معايا

بارك الله فيك ورحم والديك ووسع الله فى رزقك

[عبدللرحيم]

سهل إن شاء الله

تفضل يا اخى

 

 

OKOK_Search Between 2 Dates.xlsm

[مهند محسن]

الله عليك استاذى الكريم ماشاء الله عليك بارك الله فيك وجعله الله فى ميزان حسناتك

ورحم الله والديك ووسع فى رزقك وبارك الله فى أولادك

جزاك الله كل خير استاذى الكريم

[عبدللرحيم]

يسر الله لك كل امر

وأى خدمة 

الله المستعان

تفضل يا اخى