كود Sumproduct

[رعد داود]

السلام  عليكم 
أرفق لكم ملف  لعمل ميزان مراجعة  بالكود  بديلا" عن  الدالة التجميعية  الشرطية    sumifs 

مع فائق الشكر  والتقدير .... تــم تعديل رفع الملف , من فضلك لا تقوم برفع الملف مضغوط طالما حجمه صغير

2020المكتب.xlsm

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

جرب هذا الملف

1- العامودين B  و  C يدرج فيهما التسلسل و اسماء الحساب (بدون اكرار)
2-التاريخ في الخلايا  D2 & D1 يدرج في قوائم منسدلة (دون تكرار)
3 -اذا لم تدرج هذه المغلومات غادر الصفحة Repport ثم عد اليها

4- أخنر التاريحين من D1 و  D2 واضغط الزر Run

Option Explicit
Dim Mx As Date, Mn As Date
Dim D As Worksheet, R As Worksheet
Dim Rg_D As Range, Rg_R As Range
Dim Ro_d%, Ro_R%, m%
Dim Dic_date As Object
Dim Dic_F As Object
Sub Begin()
Set D = Sheets("data"): Set R = Sheets("Repport")
Ro_d = D.Cells(Rows.Count, 3).End(3).Row
Ro_R = R.Cells(Rows.Count, 2).End(3).Row
If Ro_R < 6 Then Ro_R = 6
   
End Sub
'+++++++++++++++++++++++++++
Sub Crete_val_data()
Dim i%
Begin
If Ro_d < 4 Then Exit Sub
Set Dic_date = CreateObject("Scripting.Dictionary")
Set Dic_F = CreateObject("Scripting.Dictionary")
For i = 4 To Ro_d

 If IsDate(D.Cells(i, 3).Value) Then
  Dic_date(D.Cells(i, 3).Value) = vbNullString
  Dic_F(D.Cells(i, 7).Value) = vbNullString
 End If
Next
  With R.Range("D1:D2").Validation
  .Delete
  .Add 3, Formula1:=Join(Dic_date.keys, ",")
  End With
 R.Range("C6").Resize(Dic_F.Count) = _
 Application.Transpose(Dic_F.keys)
 
 R.Range("B6").Resize(Dic_F.Count).Value = _
 Evaluate("Row(1:" & Dic_F.Count & ")")
End Sub
'+++++++++++++++++++++++++++++++++++
Sub get_Data()
Begin
Dim x
x = R.Cells(Rows.Count, 2).End(3).Row
R.Cells(6, 4).Resize(x - 5, 2).Formula = _
"=SUMPRODUCT(--(data!$C$4:$C$100<=$D$2),--(data!$C$4:$C$100>=$D$1),--(data!$G$4:$G$100=$C6),(IF(ISNUMBER(data!D$4:D$100),(data!D$4:D$100),0)))"
R.Cells(6, 6).Resize(x - 5).Formula = _
"=SUM(D6,-E6)"
R.Cells(6, 2).CurrentRegion.Value = _
R.Cells(6, 2).CurrentRegion.Value

End Sub

الملف مرفق

Raad.xlsm

[رعد داود]

جاري  التجربة  استاذنا  الفاضل 
والشكر  موصول  استاذ سليم