عليكم السلام
عسى أمون قد فهمت الموضوع صح
جرب هذا
Sub test()
Dim dic1 As Object: Dim dic2 As Object
Dim a, b, w, xx
Dim i&
a = Sheets("فودا").Cells(1).CurrentRegion
b = Application.Transpose(Sheets("قاعدة العملاء").Cells(1).CurrentRegion.Columns(2))
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
For i = 2 To UBound(a)
If (IsNumeric(Application.Match(a(i, 3), b, 0))) Then
If Not dic1.exists(a(i, 3)) Then
dic1.Add a(i, 3), Array(a(i, 3), a(i, 2), a(i, 7))
Else
w = dic1.Item(a(i, 3))
w(2) = w(2) + a(i, 7)
dic1.Item(a(i, 3)) = w
End If
Else
If Not dic2.exists(a(i, 3)) Then
dic2.Add a(i, 3), Array(a(i, 3), a(i, 2), a(i, 7))
Else
w = dic2.Item(a(i, 3))
w(2) = w(2) + a(i, 7)
dic2.Item(a(i, 3)) = w
End If
End If
Next
With Sheets("رحل")
Range(.Cells(3, 1), .Cells(3, 5).End(xlDown)).ClearContents
Range(.Cells(3, 8), .Cells(3, 11).End(xlDown)).ClearContents
.Cells(3, 1).Resize(dic1.Count, 3) = Application.Index(dic1.items, 0, 0)
.Cells(3, 8).Resize(dic2.Count, 3) = Application.Index(dic2.items, 0, 0)
End With
End Sub