|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub test()
- Dim sh As Worksheet, d, arA, k, h(13), i%, x%
- Set d = CreateObject("Scripting.Dictionary")
- [c2].CurrentRegion.Offset(1).ClearContents
- For Each sh In Worksheets
- If IsNumeric(Left(sh.Name, 1)) Then
- arA = sh.[a1].CurrentRegion
- For i = 2 To UBound(arA)
- If Trim(arA(i, 3)) <> "" Then
- If Not d.Exists(arA(i, 3)) Then ReDim k(13) Else k = d(arA(i, 3))
- k(0) = arA(i, 3)
- h(0) = "合计"
- For x = 4 To 15
- k(x - 3) = k(x - 3) + arA(i, x)
- h(x - 3) = h(x - 3) + arA(i, x)
- Next
- d(k(0)) = k
- End If
- Next
- End If
- Next
- d(h(0)) = h
- [c3].Resize(d.Count, 14) = Application.Rept(d.Items, 1)
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|