目录
1，汇总多行多列数据，生成二维横纵统计表举例2，汇总的二维横纵统计表，拆分为多行多列数据举例1，汇总多行多列数据，生成二维横纵统计表
在之前写过的《Excel·VBA考勤打卡记录统计出勤小时》中《统计表生成函数化、通用化》的函数可以汇总多行多列数据，生成二维横纵统计表
Private Function COLLECT(arr, term1, term2, item)'函数定义COLLECT(数组，条件1列号，条件2列号，值列号)对数组数据整理汇总，返回一个汇总后含条件的二维数组'读取数组为多行3列形式，数据汇总形式为2个条件求和，term1为纵向条件、term2为横向条件Dim dict1 As Object, dict2 As Object, result, i, j, k1, k2Set dict1 = CreateObject("scripting.dictionary")Set dict2 = CreateObject("scripting.dictionary")'表格读取的数组传递后还是从1开始计数（影响函数3个参数传参和遍历）For i = LBound(arr) To UBound(arr) 'term1为键的字典，嵌套term2为键、值为sum(item)的字典If Not dict1.Exists(arr(i, term1)) ThenSet dict1(arr(i, term1)) = CreateObject("scripting.dictionary") '字典嵌套End Ifdict1(arr(i, term1))(arr(i, term2)) = dict1(arr(i, term1))(arr(i, term2)) + arr(i, item)dict2(arr(i, term2)) = ""Nextk1 = dict1.keysk2 = dict2.keysReDim result(dict1.count, dict2.count) '从0开始计数，0即为条件，1开始为数据'横纵条件赋值到数组For i = 1 To UBound(result) '纵向result(i, 0) = k1(i - 1)NextFor j = 1 To UBound(result, 2) '横向result(0, j) = k2(j - 1)Next'sum(item)赋值到数组For i = 1 To UBound(result) '纵向For j = 1 To UBound(result, 2) '横向If dict1(result(i, 0)).Exists(result(0, j)) Thenresult(i, j) = dict1(result(i, 0))(result(0, j))End IfNextNextSet dict1 = Nothing '清除字典，释放内存Set dict2 = NothingCOLLECT = resultEnd Function
举例
《excel吧提问-竖列数据，快速匹配到表二的横向中》，3列数据中2列条件1列数据进行汇总，返回一个二维横纵统计表。对于此类问题，只需对数据进行整理即可调用该函数处理
数据整理
1，合并单元格取消合并，可使用《Excel·VBA单元格合并、撤销合并》的sub3即可
2，部分单元格有2条数据，可使用《Excel·VBA单元格内容拆分》，分割符为空格
3，将括号内的字符替换为空，再执行分列将费用名称和金额分为2列
以下为统计函数和数据读取、返回的过程
Sub 应收对帐单COLLECT()Dim arr, resulttm = Now()arr = [a2:c323].Valueresult = COLLECT(arr, 1, 2, 3) '调用函数获取返回数组[f1].Resize(UBound(result) + 1, UBound(result, 2) + 1) = resultDebug.Print ("统计完成，累计用时" & Format(Now() - tm, "hh:mm:ss")) '耗时End Sub
返回结果
2，汇总的二维横纵统计表，拆分为多行多列数据
对以上COLLECT函数执行相反操作
Private Function RECOLLECT(arr)'函数定义RECOLLECT(数组)对汇总的二维数组数据进行拆分，返回一个多行3列二维数组(返回数组从1开始计数）'COLLECT函数与RECOLLECT函数操作相反'返回数组为多行3列形式，纵向条件为第1列、横向条件为第2列、值为第3列，值为空则忽略Dim brr, r, l, ll, i, j, w, resultr = (UBound(arr) - LBound(arr) + 1) * (UBound(arr, 2) - LBound(arr, 2) + 1) '返回数组最大行数ReDim brr(1 To r, 1 To 3) '临时返回数组，从1开始计数l = LBound(arr)ll = LBound(arr, 2)For i = l + 1 To UBound(arr) '原二维数组首行首列都是标题For j = ll + 1 To UBound(arr, 2)If arr(i, j) <> "" Thenw = w + 1brr(w, 1) = arr(i, ll) '纵向条件为第1列brr(w, 2) = arr(l, j) '横向条件为第2列brr(w, 3) = arr(i, j) '值为第3列End IfNextNextIf r = w ThenRECOLLECT = brrElseReDim result(1 To w, 1 To 3) '返回数组，避免无效部分For i = 1 To wresult(i, 1) = brr(i, 1): result(i, 2) = brr(i, 2): result(i, 3) = brr(i, 3)NextRECOLLECT = resultEnd IfEnd Function
举例
对Sub 应收对帐单COLLECT()反向操作
Sub 应收对帐单RECOLLECT()Dim arr, resulttm = Now()arr = [f1].CurrentRegion.Valueresult = RECOLLECT(arr) '调用函数获取返回数组(返回数组从1开始计数）[s1].Resize(1, 3) = Array("箱号", "费用明细", "金额")[s2].Resize(UBound(result), UBound(result, 2)) = resultDebug.Print ("统计完成，累计用时" & Format(Now() - tm, "hh:mm:ss")) '耗时End Sub
返回结果
