المساعدة في تعديل بالكود

[ahmed sewelam]

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

شكرا مقدما لخبراءنا بالموقع 

الرجاء التعديل علي الكود بحيث يجمع مبيعات المندوب ومردودات المبيعات حسب التاريخ المدرج 

شاكر ومقدر

TEST.xlsm

[أبومروان]

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

يمكنك الافضل استخدام PivotTable 

TEST.xlsm

TEST.xlsm

[أبومروان]

 

[محمد هشام.]

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

Option Explicit
Private Sub CommandButton1_Click()
    Dim MinDate As Date, MaxDate As Date
    Dim WS As Worksheet, dest As Worksheet
    Dim a As Variant, tmp As String
    Dim dc As Object, dnc As Object, dnc1 As Object
    Dim arr() As Variant, n As Long, lastRow As Long, i As Long
    Dim Rng As Range, C As Range, col As Variant, key As Variant
    
    Set WS = Sheets("DATA"): Set dest = Sheets("Report")
    
    If Not IsDate(TextBox1.Value) Or Not IsDate(TextBox2.Value) Then
        MsgBox "المرجوا التحقق من التواريخ", vbExclamation
        Exit Sub
    End If
    
    MinDate = CDate(TextBox1.Value)
    MaxDate = CDate(TextBox2.Value)
    a = WS.Range("A3:I" & WS.Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    Set dc = CreateObject("Scripting.Dictionary")
    Set dnc = CreateObject("Scripting.Dictionary")
    Set dnc1 = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(a, 1)
        If a(i, 2) >= MinDate And a(i, 2) <= MaxDate Then
            tmp = Trim(a(i, 7))
            If Not dc.Exists(tmp) Then
                dnc1(tmp) = a(i, 6): dc(tmp) = a(i, 8): dnc(tmp) = a(i, 9)
            Else
                dc(tmp) = dc(tmp) + a(i, 8): dnc(tmp) = dnc(tmp) + a(i, 9)
            End If
        End If
    Next i
    
    If dc.Count > 0 Then
        Application.ScreenUpdating = False
        With dest.Range("C12:F" & dest.Rows.Count)
            .ClearContents: .ClearFormats
        End With
        
        n = 1
        ReDim arr(1 To dc.Count, 1 To 4)
        
        For Each key In dc.Keys
            arr(n, 1) = dnc1(key): arr(n, 2) = key: arr(n, 3) = dc(key): arr(n, 4) = dnc(key)
            n = n + 1
        Next key
        
        dest.Range("C12").Resize(dc.Count, 4).Value = arr
        lastRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row
        
        dest.Cells(lastRow + 1, "D").Value = "الإجمالي"
        For Each col In Array("E", "F")
            dest.Cells(lastRow + 1, col).Value = Application.WorksheetFunction.Sum(dest.Range(col & "12:" & col & lastRow))
        Next col
        dest.Range("E9").Value = MinDate: dest.Range("F9").Value = MaxDate
        
        Set Rng = dest.Range("C12:F" & lastRow)
        For Each C In Rng.Rows
            If Application.WorksheetFunction.CountA(C) > 0 Then
                C.Borders.LineStyle = xlContinuous
            End If
        Next C
        
    Else
        MsgBox "لا توجد بيانات تطابق التواريخ المحددة"
    End If
    Application.ScreenUpdating = True
End Sub

 

 

TEST v1.xlsm

تم تعديل نوفمبر 12 بواسطه محمد هشام.

[ahmed sewelam]

الف شكر للاستاذ الخلوق محمد هشام ، تم عمل المطلوب بالضبط ربنا يزيدك من علمه ويرفع قدرك 

لكن اذا في امكانية لشرح الكود الرائع ده اكون شاكر وممنون لحضرتك وجعله الله في ميزان حسناتك واخيرا الف شكر لحضرتك

تم تعديل نوفمبر 12 بواسطه ahmed sewelam

[محمد هشام.]

العفو أخي  @ahmed sewelam يسعدنا أننا إستطعنا مساعدتك 

' تحويل القيمة المدخلة الى تاريخ MinDate و MaxDate
    MinDate = CDate(TextBox1.Value)
    MaxDate = CDate(TextBox2.Value)
    
    ' جلب البيانات من النطاق A3:I
    a = WS.Range("A3:I" & WS.Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    '   قواميس لتخزين البيانات المجمعة
    ' dc لتخزين صافي المبيعات، dnc لتخزين صافي المردودات، dnc1 لتخزين المندوب
    Set dc = CreateObject("Scripting.Dictionary")
    Set dnc = CreateObject("Scripting.Dictionary")
    Set dnc1 = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(a, 1)
        'MinDate و MaxDate إذا كان التاريخ
       ' (العمود B) a(i, 2)'
        'يقع بين
        If a(i, 2) >= MinDate And a(i, 2) <= MaxDate Then
            
            tmp = Trim(a(i, 7)) ' العمود G: "المندوب"
            
    ' إذا لم يكن المندوب موجودا مسبقا في القاموس نقوم بإضافته وتخزين القيم المبدئية
          
    If Not dc.Exists(tmp) Then
                dnc1(tmp) = a(i, 6)     ' العمود F: "تخزين اسم المندوب"
                dc(tmp) = a(i, 8)       ' العمود H: "تخزين صافي المبيعات"
                dnc(tmp) = a(i, 9)      ' العمود I: "تخزين صافي المردودات"
            Else
                ' إذا كان المندوب موجودا  إضافة القيم إلى القيم المخزنة
                dc(tmp) = dc(tmp) + a(i, 8)    ' تجميع عدد المبيعات
                dnc(tmp) = dnc(tmp) + a(i, 9)  ' تجميع المردودات
            End If
        End If
    Next i
    
    'إذا كانت القواميس تحتوي على بيانات (dc.Count > 0)
    '  مطابقة للفترة الزمنية المحددة
    If dc.Count > 0 Then
        Application.ScreenUpdating = False
        
       'مسح أي محتوى سابق من النطاق C12:F في ورقة "Report"
        With dest.Range("C12:F" & dest.Rows.Count)
            .ClearContents
            .ClearFormats
        End With
        
        ' تعيين حجم المصفوفة arr بناءا على عدد العناصر في القاموس dc
        n = 1
        ReDim arr(1 To dc.Count, 1 To 4)
        
        ' تعبئة المصفوفة
        For Each key In dc.Keys
            arr(n, 1) = dnc1(key)  ' العمود الأول في arr: "كود"
            arr(n, 2) = key        ' العمود الثاني  : "المندوب"
            arr(n, 3) = dc(key)    ' العمود الثالث  : "إجمالي المبيعات"
            arr(n, 4) = dnc(key)   ' العمود الرابع  : "إجمالي المردودات"
            n = n + 1
        Next key
        
        ' نسخ محتويات المصفوفة  "Report"(C12) بداية  من الخلية
        dest.Range("C12").Resize(dc.Count, 4).Value = arr
        
        ' تحديد الصف الأخير المستخدم بعد إدراج البيانات
        lastRow = dest.Cells(dest.Rows.Count, "E").End(xlUp).Row
        
        ' إضافة "الإجمالي" في العمود D أسفل البيانات
        dest.Cells(lastRow + 1, "D").Value = "الإجمالي"
        
        'وضع الإجمالي أسفل التقرير
       '  للأعمدة E و F  (صافي المبيعات وصافي المردودات)'
        For Each col In Array("E", "F")
            dest.Cells(lastRow + 1, col).Value = Application.WorksheetFunction.Sum(dest.Range(col & "12:" & col & lastRow))
        Next col
        
        ' يتم وضع تاريخ البداية والنهاية في الخلايا E9 و F9
        dest.Range("E9").Value = MinDate
        dest.Range("F9").Value = MaxDate
        
        '  نطاق البيانات في التقرير
        Set Rng = dest.Range("C12:F" & lastRow)
        
        ' إضافة حدود حول كل صف في التقرير يحتوي على بيانات
        For Each C In Rng.Rows
            If Application.WorksheetFunction.CountA(C) > 0 Then
                C.Borders.LineStyle = xlContinuous
            End If
        Next C

 

[ahmed sewelam]

الله يبارك في عمرك بشمهندس محمد هشام ، متشكر جدا لسعة صدرك 🌹