- Sub tongji()
- Dim i, j, k, d, h1, h2, h3, h4, h5, arr
- Set d = CreateObject("Scripting.Dictionary")
- k = Sheet2.Range("a1").End(xlDown).Row
- arr = Sheet2.Range("a1:g" & k)
- h1 = Application.Match("可控總費用", Range("b:b"), 0)
- h2 = Application.Match("間接材料", Range("b:b"), 0)
- h3 = Application.Match("修繕維護費", Range("b:b"), 0)
- h4 = Application.Match("其他費用", Range("b:b"), 0)
- h5 = Application.Match("不可控費用", Range("b:b"), 0)
- For i = 2 To k
- d(arr(i, 1) & arr(i, 4)) = d(arr(i, 1) & arr(i, 4)) + arr(i, 7)
- d(arr(i, 1) & "總費用") = d(arr(i, 1) & "總費用") + arr(i, 7)
- d(arr(i, 1) & arr(i, 3)) = d(arr(i, 1) & arr(i, 3)) + arr(i, 7)
- Next i
- k = Sheet1.Range("c25").End(xlToRight).Column
- j = Sheet1.Range("b27").End(xlDown).Row
- Range("c27:O" & j) = ""
- For i = 3 To k
- For n = 27 To j
- If d(Cells(25, i) & Cells(n, 2)) = "" Then
- Cells(n, i) = "0"
- Else
- Cells(n, i) = d(Cells(25, i) & Cells(n, 2))
- End If
- Next n
- Cells(h2, i) = Application.Sum(Range(Cells(h2 + 1, i), Cells(h3 - 1, i)))
- Cells(h3, i) = Application.Sum(Range(Cells(h3 + 1, i), Cells(h4 - 1, i)))
- Cells(h4, i) = Application.Sum(Range(Cells(h4 + 1, i), Cells(h5 - 1, i)))
- Cells(h5, i) = Application.Sum(Range(Cells(h5 + 1, i), Cells(j, i)))
- Cells(h1, i) = Application.Sum(Cells(h2, i), Cells(h3, i), Cells(h4, i))
- Next i
- End Sub
复制代码
因为数据源的分类与统计表的分类不一致,具体怎么归类只有楼主知道,我不做猜测,只根据统计表格式采用后期统计的方式,并确保增加项目不影响统计,当然填表部分应该可以用数组操作,无奈数组写元素本人不甚掌握,因此采用直接写单元格的方式,希望能帮到楼主,也希望看到版主们更简洁的代码 |