[已解决]求助各位大神，路过的大神进来看看帮助一下我把~~~

ligh1298

博董的博 发表于 2013-6-3 11:27
好高端，代码您能帮解释一下吗，大概每行都表达什么意思，以前没弄过

1. Sub 求和()
   
2. Dim n%, i%, d As Object '申明变量类型
   
3. Dim arr() '申明数组
   
4. ReDim Preserve arr(1 To 500, 1 To 2) '重新申明数组，并能保留以前数据
   
5. For Each sht In Sheets '遍历工作表
   
6. If sht.Name <> "求和" Then '求和的工作表除外
   
7. For Each Rng In sht.Range("a2:a" & sht.[a65536].End(3).Row) '遍历每个工作表A列单元格（标题除外）
   
8. n = n + 1 '计数、累加
   
9. arr(n, 1) = Rng.Value '把每个工作表A列数据写入数组
   
10. arr(n, 2) = sht.Cells(Rng.Row, 2) '把每个工作表B列数据写入数组
    
11. Next
    
12. End If
    
13. Next
    
14. Set d = CreateObject("scripting.dictionary") '调用字典
    
15. For i = 1 To UBound(arr) '在数组区域内循环
    
16. d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2) '对相同的型号累加
    
17. Next
    
18. With Sheets("求和")
    
19. .Range("a2:b" & .[a65536].End(3).Row + 10).ClearContents '写入数据前先清空区域
    
20. .[a2].Resize(d.Count) = Application.Transpose(d.keys) '将每个型号（不重复）写入A列。
    
21. .[b2].Resize(d.Count) = Application.Transpose(d.items) '将对应型号的和，写入B列。
    
22. End With
    
23. MsgBox "分类求和完成，请查看！", 64 '
    
24. End Sub

复制代码

博董的博

ligh1298 发表于 2013-6-3 14:43

感谢大神，您绝对是大神，高手~！