كود البحث بين تاريخين مرفق البرنامج

[طارق زكريا حسين جاه الرسول]

بسم الله الرحمن الرحيم

بعد التحية

المطلوب ان شاء الله

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

ولكم جزيل الشكر والتقديركود البحث بين تاريخين.rar

[طارق زكريا حسين جاه الرسول]

up

up

up

[طارق زكريا حسين جاه الرسول]

للرف

للرفع

للرفع

[شوقي ربيع]

السلام عليكم

تم استخدام كمبوبوكس بدلا من التكست بوكس للبحث

تم اضافة قموس ثاني لملىء الكمبوبوكس الخاصة بالتاريخ بدون تكرار

If Not IsEmpty(keyArray(i, 1)) Then sDic2(keyArray(i, 1)) = ""

        If IsArray(keyArray) Then ComboBox3.List = sDic2.keys: ComboBox4.List = sDic2.keys

وهذا الكود المستعمل في البحث ايضا يعتمد على المصفوفات

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

If ComboBox3 = "" Then MsgBox "فضلا اختر تاريخ بداية البحث أولا": Exit Sub
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("data")
If IsDate(ComboBox3) Then a = CDate(Me.ComboBox3.Value) Else Exit Sub
If IsDate(ComboBox4) Then b = CDate(Me.ComboBox4.Value) Else Exit Sub
e = 0
Dim x As Integer: x = 0
For i = LBound(keyArray) To UBound(keyArray)
        If a <= CDate(keyArray(i, 1)) And b >= CDate(keyArray(i, 1)) Then
        e = e + 1: ReDim Preserve keyArray2(1 To 4, 1 To e)
                keyArray2(1, e) = keyArray(i, 1)
                keyArray2(2, e) = keyArray(i, 4)
                keyArray2(3, e) = keyArray(i, 5)
                keyArray2(4, e) = keyArray(i, 7)
                x = x + Val(keyArray(i, 7))
        End If
        
        If e > 0 Then
            If UBound(keyArray2, 2) > 1 Then
                Me.ListBox1.List = Application.Transpose(keyArray2)
                Else
                Dim c(1 To 1, 1 To 4)
                c(1, 1) = keyArray2(1, 1)
                c(1, 2) = keyArray2(2, 1)
                c(1, 3) = keyArray2(3, 1)
                c(1, 4) = keyArray2(4, 1)
                Me.ListBox1.List = c
            End If
        Else
                Me.ListBox1.Clear
        End If
Next
Me.TextBox1.Value = x

تحياتي للجميع

كود البحث بين تاريخين.rar

[طارق زكريا حسين جاه الرسول]

استاذى

شوقي ربيع

لاادرى كيف اشكرك

[KHMB]

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

الاستاذ ربيع شوقي

ابتدعت ومابقيت شي ممتاز جدا تقرير  اختيار الشهر والصنف والمعاينة  والتقرير الاخر بين تاريخين وتمت التجربه

جزاك الله خير وبارك الله فيك

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

الأخ الحبيب والأستاذ الكبير شوقي ربيع

حملت الملف ولا يفتح عندي ..عايز أعرف ايه سبب عدم عمل بعض الملفات في كثير من الأحيان ..أنا أعمل على 2007 ..

[شوقي ربيع]

الأخ الحبيب والأستاذ الكبير شوقي ربيع

حملت الملف ولا يفتح عندي ..عايز أعرف ايه سبب عدم عمل بعض الملفات في كثير من الأحيان ..أنا أعمل على 2007 ..

السلام عليكم

اخي ياسر المشكلة كلها بسبب التحديث الاخير الذي عملته مكروسوفت لانو فيه مشاكل كثيرة

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

بخصوص المشكلة في التحدث كمثال لما تضيف اي ابجت في الشيت من المطور ونقلا مثلا TextBox من المفروض تجدها بأسم TextBox1 لاكن تجدها بأسم TextBox21

 

هذه الاكواد المستعملة في الملف انسخها في الملف الاول ان اشتغل لديك او انشء ملف جديد كما هو الحال في الملف الاول ثم انسخ فيه الاكواد

      Dim keyArray()
      Dim keyArray2()
      Dim itemArray()
      Dim element
      Dim a, b, d, e, i


Private Sub ComboBox2_Change()

If ComboBox1 = "" Then MsgBox "اختر الشهر أولا": Exit Sub
     d = Me.ComboBox2
     e = 0
Dim bMonth As Byte
Dim x As Integer: x = 0
Me.TextBox1.Value = 0
         For i = LBound(keyArray) To UBound(keyArray)
                 bMonth = Month(keyArray(i, 1))
            If d = "كل الاصناف" And bMonth = ComboBox1.ListIndex + 1 Then
                e = e + 1: ReDim Preserve itemArray(1 To 4, 1 To e)
                itemArray(1, e) = keyArray(i, 1)
                itemArray(2, e) = keyArray(i, 4)
                itemArray(3, e) = keyArray(i, 5)
                itemArray(4, e) = keyArray(i, 7)
                x = x + Val(keyArray(i, 7))
            
            ElseIf keyArray(i, 4) = d And bMonth = ComboBox1.ListIndex + 1 Then
                e = e + 1: ReDim Preserve itemArray(1 To 4, 1 To e)
                itemArray(1, e) = keyArray(i, 1)
                itemArray(2, e) = keyArray(i, 4)
                itemArray(3, e) = keyArray(i, 5)
                itemArray(4, e) = keyArray(i, 7)
                x = x + Val(keyArray(i, 7))
                
            End If
        Next i
      
        If e > 0 Then
            If UBound(itemArray, 2) > 1 Then
                Me.ListBox1.List = Application.Transpose(itemArray)
                Else
                Dim c(1 To 1, 1 To 4)
                c(1, 1) = itemArray(1, 1)
                c(1, 2) = itemArray(2, 1)
                c(1, 3) = itemArray(3, 1)
                c(1, 4) = itemArray(4, 1)
                Me.ListBox1.List = c
            End If
        Else
                Me.ListBox1.Clear
        End If
        
  Me.TextBox1.Value = x

End Sub
 
Private Sub ComboBox3_Change()
If ComboBox4 <> "" Then Call ComboBox4_Change
End Sub


Private Sub ComboBox4_Change()
If ComboBox3 = "" Then MsgBox "فضلا اختر تاريخ بداية البحث أولا": Exit Sub
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("data")
If IsDate(ComboBox3) Then a = CDate(Me.ComboBox3.Value) Else Exit Sub
If IsDate(ComboBox4) Then b = CDate(Me.ComboBox4.Value) Else Exit Sub
e = 0
Dim x As Integer: x = 0
For i = LBound(keyArray) To UBound(keyArray)
        If a <= CDate(keyArray(i, 1)) And b >= CDate(keyArray(i, 1)) Then
        e = e + 1: ReDim Preserve keyArray2(1 To 4, 1 To e)
                keyArray2(1, e) = keyArray(i, 1)
                keyArray2(2, e) = keyArray(i, 4)
                keyArray2(3, e) = keyArray(i, 5)
                keyArray2(4, e) = keyArray(i, 7)
                x = x + Val(keyArray(i, 7))
        End If
        
        If e > 0 Then
            If UBound(keyArray2, 2) > 1 Then
                Me.ListBox1.List = Application.Transpose(keyArray2)
                Else
                Dim c(1 To 1, 1 To 4)
                c(1, 1) = keyArray2(1, 1)
                c(1, 2) = keyArray2(2, 1)
                c(1, 3) = keyArray2(3, 1)
                c(1, 4) = keyArray2(4, 1)
                Me.ListBox1.List = c
            End If
        Else
                Me.ListBox1.Clear
        End If
Next
Me.TextBox1.Value = x

End Sub

Private Sub CommandButton1_Click()
Dim i%
i = Me.ListBox1.ListCount
Sheets("طباعة").Range("A1").Value = "تقرير شهر" & " " & Me.ComboBox1 & "صنف" & " " & Me.ComboBox2
Sheets("طباعة").Range("A3:d1000").ClearContents
With Sheets("طباعة").Range("A3")
    
     If i = 0 Then GoTo 1
    .Resize(i, 4).Value = Me.ListBox1.List
End With
lr = Sheets("طباعة").Range("d1000").End(xlUp).Row
Sheets("طباعة").Range("d" & lr + 1).Value = Application.WorksheetFunction.Sum(Sheets("طباعة").Range("d2:d" & lr))
Sheets("طباعة").Range("d" & lr + 1).Offset(0, -1).Value = Application.WorksheetFunction.Sum(Sheets("طباعة").Range("c2:c" & lr))
Sheets("طباعة").Range("d" & lr + 1).Offset(0, -2).Value = "الإجمالي"
Sheets("طباعة").Select
ActiveSheet.PageSetup.PrintArea = "A1:D" & lr + 1
Unload Me
ActiveWindow.SelectedSheets.PrintPreview
a = MsgBox("هل ترغب في طباعة التقرير؟", vbYesNo + vbQuestion, "طباعة")
If a = vbYes Then
With ActiveSheet
.PrintOut
End With
End If
Range("A3").Activate
1 Unload Me
End Sub

Private Sub UserForm_Initialize()
Me.RightToLeft = False
ComboBox1.List = Array("يناير", "فبراير", "مارس", "ابريل", "مايو", "يونيو", "يوليو", "اغسطس", "سبتمبر", "اكتوبر", "نوفمبر", "ديسمبر")
Me.ListBox1.ColumnCount = 4
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("data")
    Dim iRow As Long: iRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Dim sDic, sDic2             As Object
    Set sDic = CreateObject("Scripting.Dictionary")
    Set sDic2 = CreateObject("Scripting.Dictionary")
  keyArray = ws.Range("A3:G" & iRow).Value
  
            For i = LBound(keyArray) To UBound(keyArray)
                If Not IsEmpty(keyArray(i, 4)) Then sDic(keyArray(i, 4)) = ""
                If Not IsEmpty(keyArray(i, 1)) Then sDic2(keyArray(i, 1)) = ""
            Next i
        If IsArray(keyArray) Then ComboBox2.List = sDic.keys
        If IsArray(keyArray) Then ComboBox3.List = sDic2.keys: ComboBox4.List = sDic2.keys
            ComboBox2.AddItem "كل الاصناف"
End Sub

[سـامي 169]

جزيل الشكر لك ... بارك الله فيك ...