前两天在解决一位学员的问题时遇到的一个情况：

一、利用工作表函数Sumifs

Sub test1()

Dim t!, sht1 As Worksheet, sht2 As Worksheet, lastrow1&, lastrow2&, arr, brr(), y%, m%, d%, wsf As Object

t = Timer

Set sht1 = Sheets("DATA")

Set sht2 = Sheets("查询")

lastrow1 = sht1.UsedRange.Rows.Count

lastrow2 = sht2.UsedRange.Rows.Count

arr = sht2.Range("d2:g" & lastrow2)

ReDim brr(1 To UBound(arr), 1 To 1)

With sht2

y = .[i3]

m = .[j3]

d = .[k3]

End With

Set wsf = Application.WorksheetFunction

For i = 1 To UBound(arr)

With sht1

brr(i, 1) = wsf.SumIfs(.Range("h2:h" & lastrow1), _

.Range("b2:b" & lastrow1), y, _

.Range("c2:c" & lastrow1), m, _

.Range("d2:d" & lastrow1), d, _

.Range("e2:e" & lastrow1), arr(i, 1), _

.Range("f2:f" & lastrow1), arr(i, 2), _

.Range("g2:g" & lastrow1), arr(i, 3))

End With

Next

sht2.[g2].Resize(UBound(arr), 1) = brr

MsgBox Timer - t

End Sub

Sub test2()

Dim t!, sht1 As Worksheet, sht2 As Worksheet, lastrow1&, lastrow2&, arr, brr(), y%, m%, d%, dic As Object

t = Timer

Set sht1 = Sheets("DATA")

Set sht2 = Sheets("查询")

lastrow1 = sht1.UsedRange.Rows.Count

lastrow2 = sht2.UsedRange.Rows.Count

arr = sht1.Range("a2:h" & lastrow1)

Set dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(arr)

mystr = arr(i, 2) & arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6) & arr(i, 7)

If dic.exists(mystr) Then

dic(mystr) = dic(mystr) + arr(i, 8)

Else

dic(mystr) = arr(i, 8)

End If

Next

arr = sht2.Range("d2:g" & lastrow2)

ReDim brr(1 To UBound(arr), 1 To 1)

With sht2

y = .[i3]

m = .[j3]

d = .[k3]

End With

For i = 1 To UBound(arr)

mystr = y & m & d & arr(i, 1) & arr(i, 2) & arr(i, 3)

If dic.exists(mystr) Then

brr(i, 1) = dic(mystr)

Else

brr(i, 1) = 0

End If

Next

sht2.[g2].Resize(UBound(arr), 1) = brr

MsgBox Timer - t

End Sub