指定条件但列号变化的条件求和，用vba代码如何填写？

Question

表一 （数据区）
房号 管理费 租金 空调费 （空白） （空白）……
A001 100 800 2
A002 200 500 80
A001 500 2000 23
A002 0 1000 65
A001 500 0 40
合计 1300 4300 210

表二（统计计算区，即想要的结果）
房号 租金 管理费 垃圾费 增容费 空调费 合计
A001 2800 1100 0 0 65 3965
A002 1500 200 0 0 145 1845
A003 0 0 0 0 0 0
合计 4300 1300 0 0 210 5810

将表一中的数据统计后，放入表二中，两只列栏目名称所在列，是不一致的，是可变化的，请大师们帮忙编个vba代码，函数量太大，影响速度，必须使用vba。
回答的易懂，再加分。
感谢52027381大师的解答，我的邮箱收到了度娘的提示，但知道吧的提问里面无显示，现将其答案放入提问补充问题里面。以示感谢，但却不能设置满意答案了，不知道度娘这是肿么了。
知道网友52027381在 2012年9月14日 00:47 回答了您的提问。
问：指定条件但列号变化的条件求和，用vba代码如何填写？
答：Sub abc()
Dim R As Long
R = Sheet1.Range("A65536").End(xlUp).Row - 1
Dim D As Object
Set D = CreateObject("scripting.dictionary")
Dim Arr
Arr = Sheet1.Range("a1:d" & R)
Dim i As Long, j As Integer
For j = 2 To UBound(Arr, 2)
For i = 2 To UBound(Arr, 1)
D(Arr(i, 1) & "-" & Arr(1, j)) = D(Arr(i, 1) & "-" & Arr(1, j)) + Arr(i, j)
Next
Next

Dim Brr, y As String
Brr = Sheet2.Range("a1:f4")
For j = 2 To UBound(Brr, 2)
For i = 2 To UBound(Brr, 1)
y = Brr(i, 1) & "-" & Brr(1, j)
If D.exists(y) Then
Sheet2.Cells(i, j) = D.Item(y)
End If
Next
Next
End Sub

Answer 1

Sub test()
Sheets("表二").Range("a1").Consolidate "表一!c1:c6", xlSum, True, True
End Sub追问

表二的列是固定的，表一的列是变化的，你的方法没能处理这个问题哦

追答

合并计算完成后调整列的顺序，删除多余的列。
代码自己录制宏。

追问

很感谢你的思路，虽然不是我的要求，又学了一个新知识

Answer 2

Sub abc()
Dim R As Long
R = Sheet1.Range("A65536").End(xlUp).Row - 1
Dim D As Object
Set D = CreateObject("scripting.dictionary")
Dim Arr
Arr = Sheet1.Range("a1:d" & R)
Dim i As Long, j As Integer
For j = 2 To UBound(Arr, 2)
For i = 2 To UBound(Arr, 1)
D(Arr(i, 1) & "-" & Arr(1, j)) = D(Arr(i, 1) & "-" & Arr(1, j)) + Arr(i, j)
Next
Next

Dim Brr, y As String
Brr = Sheet2.Range("a1:f4")
For j = 2 To UBound(Brr, 2)
For i = 2 To UBound(Brr, 1)
y = Brr(i, 1) & "-" & Brr(1, j)
If D.exists(y) Then
Sheet2.Cells(i, j) = D.Item(y)
End If
Next
Next
End Sub本回答被提问者采纳