|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub 汇总()
- Dim vData As Variant, nRow As Double, nCol As Integer, oDic As Object, vKey As Variant
- Dim sMonth As String, sDpt As String, sType As String, nVal As Double
- Dim vSH As Variant, nSH As Integer, vFill As Variant
-
- Set oDic = CreateObject("Scripting.Dictionary")
- vSH = [{"按類別分析","按部門分析"}]
- vData = Sheets("總表").[B2].CurrentRegion.Value
- For nRow = 2 To UBound(vData)
- sMonth = Trim(vData(nRow, 1))
- sDpt = Trim(vData(nRow, 2))
- sType = Trim(vData(nRow, 3))
- nVal = Val(vData(nRow, 4))
- If sMonth <> "" And sDpt <> "" And sType <> "" Then
- oDic(sMonth & "|" & sDpt & "|" & sType) = nVal '每月、每部门、每成本类别的金额
- oDic(sMonth & "|" & sDpt & "|" & "成本小計") = oDic(sMonth & "|" & sDpt & "|" & "成本小計") + nVal '每月、每部门的成本小计
- oDic(sMonth & "|" & sType & "|" & sDpt) = nVal '每月、每成本类别、每部门的金额
- oDic(sMonth & "|" & sType & "|" & "成本小計") = oDic(sMonth & "|" & sType & "|" & "成本小計") + nVal '每月、每成本类别的成本小计
- oDic("加總|" & sDpt & "|" & sType) = oDic("加總|" & sDpt & "|" & sType) + nVal '每部门、每成本类别的总计
- oDic("加總|" & sType & "|" & sDpt) = oDic("加總|" & sType & "|" & sDpt) + nVal '每部门、每成本类别的总计
- oDic("加總|" & sDpt & "|成本小計") = oDic("加總|" & sDpt & "|成本小計") + nVal '每部门的总计
- oDic("加總|" & sType & "|成本小計") = oDic("加總|" & sType & "|成本小計") + nVal '每成本类别的总计
- End If
- Next
- For nSH = 0 To 1
- With Sheets(vSH(nSH + 1))
- vData = .[B2].CurrentRegion.Value
- vFill = Empty
- Debug.Print .[A2].CurrentRegion.Address
- ReDim vFill(2 To UBound(vData), 3 To UBound(vData, 2))
- vKey = Empty
- ReDim vKey(1 To 2)
- For nRow = 2 To UBound(vData)
- vKey(1) = Trim(vData(nRow, 1))
- vKey(2) = Trim(vData(nRow, 2))
- If vKey(1 - (nSH = 1) * 1) = "" Then
- vKey(1 - (nSH = 1) * 1) = sDpt
- Else
- sDpt = vKey(1 - (nSH = 1) * 1)
- End If
- If vKey(2 + (nSH = 1) * 1) = "" Then
- vKey(2 + (nSH = 1) * 1) = sType
- Else
- sType = vKey(2 + (nSH = 1) * 1)
- End If
- For nCol = 3 To UBound(vData, 2)
- sMonth = Trim(vData(1, nCol))
- vFill(nRow, nCol) = oDic(sMonth & "|" & vKey(1) & "|" & vKey(2))
- Next
- Next
- .[D3].Resize(UBound(vFill) - 1, UBound(vFill, 2) - 2) = vFill
- End With
- Next
- End Sub
复制代码 |
|