[已解决]设置金额

雄鹰2013

设置金额

最佳答案

月排行榜 / 总排行榜

grf1973

2014-12-29 14:24

请看附件。

跳转到最佳答案楼层

雄鹰2013

附件如下

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For Each sh In Worksheets
   
4.         If sh.Name <> "目录" Then
   
5.             arr = sh.[a1].CurrentRegion
   
6.             For i = 3 To UBound(arr)
   
7.                 xkey = arr(i, 2) & arr(i, 3) & sh.Name
   
8.                 d(xkey) = d(xkey) + arr(i, 4)      '日期+姓名+项目汇总
   
9.                 ykey = arr(i, 3)
   
10.                 d(arr(i, 3)) = d(arr(i, 3)) + arr(i, 4)     '姓名汇总
    
11.             Next
    
12.         End If
    
13.     Next
    
14.     arr = [a1].CurrentRegion
    
15.     For i = 3 To UBound(arr)
    
16.         xkey = arr(i, 3) & arr(i, 4) & arr(i, 5)
    
17.         arr(i, 6) = d(xkey)        '日期+姓名+项目汇总结果
    
18.         arr(i, 7) = d(arr(i, 4))        '姓名汇总结果
    
19.     Next
    
20.     [a1].CurrentRegion = arr
    
21. End Sub
    

复制代码

grf1973

请看附件。