[已解决]按照3级汇总,然后写进批注

zhj1978

首先按照对方科目、二级科目、部门汇总出金额来;
然后把汇总的金额的对应的摘要和金额写进批注,由几个写几个.
例如:管理部的管理费用--办公费54.1,他是由发合同快递费13;税务登记证打车费   38.1;公司扫描证照费用 3组成,然后写进对应批注.
请帮忙

最佳答案

月排行榜 / 总排行榜

810126769

2014-4-6 16:04

zhj1978 发表于 2014-4-6 12:06
答案期待中

已经修改，请测试：
(, 下载次数: 14)

上传

点击文件名下载附件

跳转到最佳答案楼层

zhj1978

在线等,急急急

zhj1978

在线等,急急急

ghostjiao

{:1312:}好难啊，先搬个板凳等学习

zhj1978

在线等,急急急

windimi007

zhj1978 发表于 2014-4-4 12:27
在线等,急急急

就这点数据的话无须使用VBA来处理吧！{:1812:}
楼主需要说明是不是只需对CDE3列进行处理？{:4512:}

zhj1978

windimi007 发表于 2014-4-4 13:00
就这点数据的话无须使用VBA来处理吧！
楼主需要说明是不是只需对CDE3列进行处理？

我只是举了个例子,说明情况,其实数据源很多的,请帮忙

windimi007

zhj1978 发表于 2014-4-4 13:06
我只是举了个例子,说明情况,其实数据源很多的,请帮忙

大致做了下，请测试！{:1712:}

1. Sub test()
   
2. Dim d As Object
   
3. Dim ar
   
4. Dim i As Long, j As Long
   
5. Dim sr As String
   
6. Application.ScreenUpdating = False
   
7. Cells.ClearComments
   
8. Set d = CreateObject("scripting.dictionary")
   
9. ar = Sheet1.Cells(1, 1).CurrentRegion
   
10. For i = 2 To UBound(ar)
    
11. sr = ar(i, 4) & vbTab & ar(i, 5)
    
12. If d.exists(sr) Then
    
13. d(sr) = d(sr) & vbCrLf & ar(i, 6) & " " & ar(i, 7)
    
14. Else
    
15. d.Add sr, ar(i, 6) & " " & ar(i, 7)
    
16. End If
    
17. Next i
    
18. ar = Sheet2.Cells(1, 1).CurrentRegion
    
19. For i = 3 To UBound(ar)
    
20. For j = 3 To UBound(ar, 2)
    
21. sr = ar(2, j) & vbTab & ar(i, 2)
    
22. If d.exists(sr) Then Cells(i, j).AddComment d(sr)
    
23. Next j
    
24. Next i
    
25. Application.ScreenUpdating = True
    
26. End Sub
    

复制代码

windimi007

zhj1978 发表于 2014-4-4 13:06
我只是举了个例子,说明情况,其实数据源很多的,请帮忙

完善了下，请再测试哈！{:1712:}

1. Sub test()
   
2.     Dim d As Object
   
3.     Dim ar
   
4.     Dim i As Long, j As Long
   
5.     Dim sr As String
   
6.     Application.ScreenUpdating = False
   
7.     Cells.ClearComments
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     ar = Sheet1.Cells(1, 1).CurrentRegion
   
10.     For i = 2 To UBound(ar)
    
11.         sr = ar(i, 4) & vbTab & ar(i, 5)
    
12.         If d.exists(sr) Then
    
13.             d(sr) = d(sr) & vbCrLf & ar(i, 6) & " " & ar(i, 7)
    
14.         Else
    
15.             d.Add sr, ar(i, 6) & " " & ar(i, 7)
    
16.         End If
    
17.     Next i
    
18.     ar = Sheet2.Cells(1, 1).CurrentRegion
    
19.     For i = 3 To UBound(ar)
    
20.         For j = 3 To UBound(ar, 2)
    
21.             sr = ar(2, j) & vbTab & ar(i, 2)
    
22.             If d.exists(sr) Then
    
23.                 With Cells(i, j)
    
24.                     .AddComment d(sr)
    
25.                     .Comment.Shape.TextFrame.AutoSize = True
    
26.                 End With
    
27.             End If
    
28.         Next j
    
29.     Next i
    
30.     Application.ScreenUpdating = True
    
31. End Sub
    

复制代码

zhj1978

windimi007 发表于 2014-4-4 13:22
大致做了下，请测试！

首先按照对方科目、二级科目、部门汇总出金额来.
第一步就没有实现,首先先汇总,然后写批注