Excel VBA 代替Sumproduct实现多条件求和

因为用函数公式，如果数据量大的话，会影响效率，而且会增加文件本身大小，所以想用vba代码替代。

以下代码用来实现函数公式sumproduct的功能，实现多条件求和。

Private Sub 多条件求和()
   Dim d, ar, arr, s$, t$, i&
   Set d = CreateObject("Scripting.Dictionary")
   ar = Range("b2:m" & [b65536].End(3).Row)
   arr = Sheet3.Range("b2", Sheet3.[j65536].End(3)).Value
  
   For i = 1 To UBound(arr)
      t = Join(Application.Index(Application.Index(arr, i, 0), Array(1, 2, 3, 4)), ",")
      d(t) = d(t) + arr(i, 8)
   Next
  
   For i = 1 To UBound(ar)
      s = Join(Application.Index(Application.Index(ar, i, 0), Array(1, 2, 3, 4)), ",")
      If d.exists(s) Then ar(i, 11) = d(s) Else ar(i, 11) = ""
   Next
[b2].Resize(UBound(ar), UBound(ar, 2)) = ar
     
Set d = Nothing
  
  Call sum2

End Sub

Sub sum2()
arr = Range("f2:k" & [f65536].End(3).Row)
For i = 1 To UBound(arr)
  t1 = arr(i, 1) * arr(i, 2)
  t2 = (arr(i, 1) - arr(i, 4)) * arr(i, 2) + arr(i, 3) * arr(i, 4)
  If arr(i, 4) = "" Then arr(i, 6) = t1 Else arr(i, 6) = t2
Next
[f2].Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub