|
发表于 2011-10-29 22:33
|
显示全部楼层
本楼为最佳答案
- Sub test()
- Columns("d:f").Replace " ", ""
- Dim A, dic1, dic2, dic3, i
- A = Range("C3:F" & Range("C3").End(xlDown).Row)
- Set dic1 = CreateObject("scripting.dictionary")
- Set dic2 = CreateObject("scripting.dictionary")
- Set dic3 = CreateObject("scripting.dictionary")
- For i = 1 To UBound(A)
- dic1(A(i, 1)) = dic1(A(i, 1)) + A(i, 2) '预收
- dic2(A(i, 1)) = dic2(A(i, 1)) + A(i, 3) '应收
- dic3(A(i, 1)) = dic3(A(i, 1)) + A(i, 4) '已收
- Next i
-
- Columns("i:m").Clear
- Range("c2:F2").Copy Range("i2")
- Range("m2") = "未收帐款"
- Range("i3").Resize(dic1.Count, 1) = Application.Transpose(dic1.keys)
- Range("j3").Resize(dic1.Count, 1) = Application.Transpose(dic1.Items)
- Range("k3").Resize(dic1.Count, 1) = Application.Transpose(dic2.Items)
- Range("l3").Resize(dic1.Count, 1) = Application.Transpose(dic3.Items)
- Range("m3").Formula = "=K3-J3-L3"
- Range("m3").AutoFill Destination:=Range("M3:M" & 2 + dic1.Count)
- Range("i1") = "合计"
- Range("j1").Formula = "=SUM(j3:j" & 2 + dic1.Count & ")"
- Range("k1").Formula = "=SUM(k3:k" & 2 + dic1.Count & ")"
- Range("l1").Formula = "=SUM(l3:l" & 2 + dic1.Count & ")"
- Range("m1").Formula = "=SUM(m3:m" & 2 + dic1.Count & ")"
- Range("i1").CurrentRegion.Borders.LineStyle = 1
- End Sub
复制代码
2.rar
(16.54 KB, 下载次数: 23)
|
|