凡是需要实现Countifs或者Sumifs的功能,用字典做再合适不过了
Sub Test()
On Error Resume Next
Dim Dic As Object, Stri As String, i As Integer
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To Cells(Rows.Count, 1).End(3).Row
If Cells(i, 1) = "" And Cells(i, 3) = "" Then GoTo Nexti:
Stri = Cells(i, 1) & "{*}" & Cells(i, 3)
If Dic.Exists(Stri) Then Dic(Stri) = Dic(Stri) + Cells(i, 2) Else Dic(Stri) = Cells(i, 2)
Nexti:
Next
For i = 1 To Cells(Rows.Count, 6).End(3).Row
Stri = Cells(i, 6) & "{*}" & Cells(i, 8)
Cells(i, 7) = Dic(Stri)
Next
Set Dic = Nothing
End Sub
测试无误
求和 即可