zhj1978 发表于 2014-4-7 11:43
不错,请将你代码加上注释吧,越详细越好,谢谢
输出、合并单元格可参考17L- Sub aa()
- Dim crr(1 To 10) '部门10个
- Dim zj() '末行总计
- Dim huiz() '中间行汇总
- Dim heji() '末列总计
- Dim drr() '统计结果
- R = Sheets("数据源").Range("a" & Rows.Count).End(3).Row
- arr = Sheets("数据源").Range("a2:g" & R)
- brr = YjhSort(arr, "a,a,a", "3,5,4", "c,7;2;3,7;3;3,7;3;3;a,6;3;3;a")
- '3级分类:"3,5,4"分类 所在列。
- '4次统计:"c,7;2;3,7;3;3,7;3;3;a,6;3;3;a"
- '1统计:7;2;3 7列数据,2级汇总,结果在brr( ,2)
- '2统计:7;3;3 7列数据,3级汇总,结果在brr( ,3)
- '3统计:7;3;3;a 7列数据,3级明细,结果在brr( ,4)
- '4统计:6;3;3;a 6列数据,3级明细,结果在brr( ,5)
- 'brr():1列末级项目名
- 'brr():5列各级项目名
- 'brr():6列各级分类依据项目名
- ReDim drr(1 To UBound(brr, 1) * 2, 1 To UBound(crr) + 2)
- ci = 0 '已统计部门数
- ReDim heji(1 To UBound(drr, 1))
- ReDim huiz(UBound(drr, 2))
- ReDim zj(UBound(drr, 2))
- Range("a1").Resize(UBound(drr, 1), UBound(drr, 2)).ClearComments '清除原批注
- 'Cells.Delete
- ii = 0 '统计结果行数
- For i = 1 To UBound(brr, 1)
- sfl = Split(brr(i, 6), "|")
- If ii = 0 Then
- ii = 1
- drr(ii, 1) = sfl(0)
- drr(ii, 2) = sfl(1)
- End If
- j = QLook(sfl(2), crr, 1) '查找部门对应列
- If j > ci Then '末找到
- ci = ci + 1
- crr(ci) = sfl(2) '记录新部门
- j = ci
- End If
-
- If drr(ii, 1) <> sfl(0) And ii > 1 Then '新一级分类处理
- ii = ii + 1
- drr(ii, 1) = drr(ii - 1, 1) '& " 汇总" '如a列加“ 汇总”:则下行注释
- drr(ii, 2) = "汇总"
- heji(ii) = huiz(0)
- zj(0) = zj(0) + huiz(0)
- For jj = 1 To ci
- drr(ii, 2 + jj) = huiz(jj)
- zj(jj) = zj(jj) + huiz(jj)
- Next
- ReDim huiz(UBound(drr, 2))
- End If
-
- If drr(ii, 1) & drr(ii, 2) <> sfl(0) & sfl(1) Then '新二级分类处理
- ii = ii + 1
- drr(ii, 1) = sfl(0)
- drr(ii, 2) = sfl(1)
- End If
- drr(ii, 2 + j) = brr(i, 3)
- If Not IsEmpty(brr(i, 2)) Then
- heji(ii) = brr(i, 2)
- huiz(0) = huiz(0) + brr(i, 2)
- End If
- huiz(j) = huiz(j) + brr(i, 3)
-
- '添加批注
- pz1 = Split(brr(i, 5), "|")
- pz2 = Split(brr(i, 4), "|")
- If UBound(pz1) >= 0 Then
- pz = ""
- For j0 = 0 To UBound(pz1)
- pz = pz & Chr(10) & pz1(j0) & ":" & pz2(j0)
- Next
- pz = Mid(pz, 2)
- Range("b3").Offset(ii - 1, j).AddComment (pz)
- End If
- Next
- '末汇总处理
- ii = ii + 1
- drr(ii, 1) = drr(ii - 1, 1)
- drr(ii, 2) = "汇总"
- heji(ii) = huiz(0)
- zj(0) = zj(0) + huiz(0)
- For j = 1 To ci
- drr(ii, j + 2) = huiz(j)
- zj(j) = zj(j) + huiz(j)
- Next
- '总计处理
- ii = ii + 1
- drr(ii, 1) = "总计"
- heji(ii) = zj(0)
- For j = 1 To ci
- drr(ii, 2 + j) = zj(j)
- Next
-
- '输出结果
- Range("a3").Resize(ii, UBound(drr, 2)) = drr
- Range("c2").Resize(1, ci) = crr
- Range("a1").Resize(1, 2) = Array("对方科目", "二级科目")
- Range("c1").Resize(1, ci) = "部门"
- Range("b2").Offset(0, ci + 1) = "总计"
- Range("a3").Offset(0, ci + 2).Resize(ii, 1) = Application.Transpose(heji)
- End Sub
复制代码 |