Dim i&, x&, arr, brr(), str1$
Dim d As Object
Set d = CreateObject("scripting dictionary")
With Sheets("統計")
arr = .Range("E3:H" & .Range("E65536").End(xlUp).Row)
For x = 1 To UBound(arr)
str1 = arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)
If Not d.exists(str1) Then
i = i + 1
ReDim Preserve brr(1 To 4, 1 To i)
brr(1, i) = arr(x, 1)
brr(2, i) = arr(x, 2)
brr(3, i) = arr(x, 3)
End If
brr(4, d(str1)) = brr(4, d(str1)) + arr(x, 4)
Next x
.Range("K3").Resize(UBound(brr, 2), 4) = Application.Transpose(brr)
End With
End Sub
這才是妳要的代碼