数据源：
结果要求显示如下图：
按钮代码如下：
Sub 字典条件计算多列并行()
Dim i, j, arr, brr, key
Dim sht As Worksheet
Set sht = Sheet8
Application.Calculation = xlManual
Dim dic
ReDim brr(3) '0毛利率求和,1毛利率计数,2运费总支出,3销售数量
Set dic = CreateObject("scripting.dictionary")
For i = 4 To sht.Cells(Rows.Count, "B").End(xlUp).Row
If sht.Cells(i, "B") = Sheet1.[B1] Then
key = Application.Text(sht.Cells(i, "R"), "yyyy-mm")
If Not dic.exists(key) Then '首次进入字典 初始化数组装入
ReDim brr(3)
dic(key) = brr
End If
brr = dic(key)
brr(0) = brr(0) + sht.Cells(i, "K") '毛利率
brr(1) = brr(1) + 1
brr(2) = brr(2) + sht.Cells(i, "O") '2运费总支出
brr(3) = brr(3) + sht.Cells(i, "E") '3销售数量
dic(key) = brr
End If
Next
''输出
''按汇总表月份列顺序输出
n = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
ReDim crr(3 To n, 2 To 4)
For i = 3 To Sheet1.Cells(Rows.Count, "A").End(xlUp).Row '拿到输出表的字典顺序
key = Application.Text(Sheet1.Cells(i, "A"), "yyyy-mm")
'crr(i, 1) = key
If dic.exists(key) Then
brr = dic(key)
crr(i, 2) = Application.Round(brr(0) / brr(1), 2) '平均值=求和/计数
crr(i, 3) = brr(2) '2运费总支出
crr(i, 4) = brr(3) '3销售数量
End If
Next
' Sheet3.Range("A2").Resize(10000, 4).ClearContents '清空结果区
'Sheet3.Range("A2").Resize(n - 2, 4) = crr
Sheet1.Range("B3").Resize(n - 2, 3) = crr
'Application.Calculation = xlAutomatic
End Sub
说明：多行数据采用字典多条件求和一次输出，主要是在有日期的的列，按月份条件使用。
如2023年1月：使用2023/1/1表达。
