[已解决]老师：怎样做这个汇总

股网千王

Book1.zip (144.94 KB, 下载次数: 12)

2016-3-30 17:27 上传

点击文件名下载附件 老师：怎样写这个VBA代码。按照sheet1汇总sheet2

最佳答案

月排行榜 / 总排行榜

dsmch

2016-3-30 18:25

1. Sub Macro1()
   
2. Dim arr, brr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 2 To UBound(brr)
   
7.     d(brr(i, 1)) = d(brr(i, 1)) + brr(i, 5)
   
8. Next
   
9. For i = 2 To UBound(arr)
   
10.     If d.exists(arr(i, 1)) Then
    
11.         arr(i, 4) = d(arr(i, 1))
    
12.     Else
    
13.         arr(i, 4) = 0
    
14.     End If
    
15. Next
    
16. Sheet1.Range("d1").Resize(UBound(arr)) = Application.Index(arr, 0, 4)
    
17. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 2 To UBound(brr)
   
7.     d(brr(i, 1)) = d(brr(i, 1)) + brr(i, 5)
   
8. Next
   
9. For i = 2 To UBound(arr)
   
10.     If d.exists(arr(i, 1)) Then
    
11.         arr(i, 4) = d(arr(i, 1))
    
12.     Else
    
13.         arr(i, 4) = 0
    
14.     End If
    
15. Next
    
16. Sheet1.Range("d1").Resize(UBound(arr)) = Application.Index(arr, 0, 4)
    
17. End Sub

复制代码

lichuanboy44

dsmch 发表于 2016-3-30 18:25

学习了

股网千王

dsmch 发表于 2016-3-30 18:25

多谢老师指导