[英]SUMIFS faster in vba array and scripting.dictionary
我想使用 vba sumifs 数组和 scripting.dictionary 因为有十万条记录可能是最好的解决方案。 信息表“DBALL”是源,表“RECON”是结果。 我还在下面找到了 vba 代码,但它与结果不匹配。
信息公式表 "RECON" 列 B "In" = SUMIFS(DBALL:$A$2,$A$5:DBALL,$C$2,$C$5:RECON,$A2,DBALL!$B$2:$B$5,RECON !B$1)
信息公式表 "RECON" 列 c "Out" = SUMIFS(DBALL:$A$2,$A$5:DBALL,$C$2,$C$5:RECON,$A2,DBALL!$B$2:$B$5,RECON !C$1)
信息公式表“侦察”列 d“差异”= B2-C2
谢谢
Sub SUMIFSFASTER()
Dim arr, ws, rng As Range, keyCols, valueCol As Long, destCol As Long, i As Long, frm As String, sep As String
Dim t, dict, arrOut(), arrValues(), v, tmp, n As Long
keyCols = Array(2, 3) 'these columns form the composite key
valueCol = 1 'column with values (for sum)
destCol = 4 'destination for calculated values
t = Timer
Set ws = Sheets("DBALL")
Set rng = ws.Range("A1").CurrentRegion
n = rng.Rows.Count - 1
Set rng = rng.Offset(1, 0).Resize(n) 'exclude headers
'build the formula to create the row "key"
For i = 0 To UBound(keyCols)
frm = frm & sep & rng.Columns(keyCols(i)).Address
sep = "&""|""&"
Next i
arr = ws.Evaluate(frm) 'get an array of composite keys by evaluating the formula
arrValues = rng.Columns(valueCol).Value 'values to be summed
ReDim arrOut(1 To n, 1 To 1) 'this is for the results
Set dict = CreateObject("scripting.dictionary")
'first loop over the array counts the keys
For i = 1 To n
v = arr(i, 1)
If Not dict.exists(v) Then dict(v) = Array(0, 0) 'count, sum
tmp = dict(v) 'can't modify an array stored in a dictionary - pull it out first
tmp(0) = tmp(0) + 1 'increment count
tmp(1) = tmp(1) + arrValues(i, 1) 'increment sum
dict(v) = tmp 'return the modified array
Next i
'second loop populates the output array from the dictionary
For i = 1 To n
arrOut(i, 1) = dict(arr(i, 1))(1) 'sumifs
'arrOut(i, 1) = dict(arr(i, 1))(0) 'countifs
'arrOut(i, 1) = dict(arr(i, 1))(1) / dict(arr(i, 1))(0) 'averageifs
Next i
'populate the results
rng.Columns(destCol).Value = arrOut
Debug.Print "Checked " & n & " rows in " & Timer - t & " secs"
End Sub
资源
结果
正如评论中所说,使用 pivot 表可能是更好的解决方案。 电源 pivot。
如果您正在寻求 VBA 的解决方案并且想要使用字典,我可能会使用以下代码。
首先,您需要创建一个 class cVal
来存储您所追求的值
Option Explicit
Public qtyIn As Double
Public qtyOut As Double
然后你可以使用下面的代码
Option Explicit
Sub useDict()
Const COL_VAL = 1
Const COL_INOUT = 2
Const COL_COMBINE = 3
Const GRO_IN = "IN"
Const GRO_OUT = "OUT"
Dim rg As Range, ws As Worksheet
' Get the range with the data
Set ws = Worksheets("DBALL")
Set rg = ws.Range("A1").CurrentRegion
Set rg = rg.Offset(1, 0).Resize(rg.Rows.Count - 1)
Dim vDat As Variant
vDat = rg
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim Key As Variant, gro As Variant
Dim i As Long, sngVal As cVal
For i = LBound(vDat, 1) To UBound(vDat, 1)
' Key of the dictionary
Key = vDat(i, COL_COMBINE)
' trim the value and do not consider upper/lower case
gro = UCase(Trim(vDat(i, COL_INOUT)))
If dict.Exists(Key) Then
' just increase the "member" values of the already stored object
Set sngVal = dict(Key)
With sngVal
If gro = GRO_IN Then
.qtyIn = .qtyIn + vDat(i, COL_VAL)
End If
If gro = GRO_OUT Then
.qtyOut = .qtyOut + vDat(i, COL_VAL)
End If
End With
Else
' Create a new object which stores the summed values for "IN" resp "OUT"
Set sngVal = New cVal
With sngVal
If gro = GRO_IN Then
.qtyIn = vDat(i, COL_VAL)
End If
If gro = GRO_OUT Then
.qtyOut = vDat(i, COL_VAL)
End If
End With
dict.Add Key, sngVal
End If
Next i
' write Dictionary
' put the values of the dictionary in an array
' this is faster than writing each single line directly to the sheet
ReDim vDat(1 To dict.Count, 1 To 4)
i = 1
For Each Key In dict.Keys
vDat(i, 1) = Key
vDat(i, 2) = dict(Key).qtyIn
vDat(i, 3) = dict(Key).qtyOut
vDat(i, 4) = Abs(dict(Key).qtyIn - dict(Key).qtyOut)
i = i + 1
Next Key
'write Header
Set rg = Worksheets("RECON").Range("A1")
Set rg = rg.Resize(, 4)
rg.Clear
rg = Array("COMBINE", "In", "Out", "Diff")
Set rg = Worksheets("RECON").Range("A2")
Set rg = rg.Resize(dict.Count, 4)
rg.Clear
rg = vDat
End Sub
但我怀疑它是否比 Pivot 表更快
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.