字典汇总

misluo

附件数据汇总遇到两个问题：1、需要先筛选摒弃部分不符合条件数据  2、对数据先需要做相应替换然后用字典汇总。具体详见附件，有劳

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, d, x$
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Sheet1.Activate
   
5. [c2:c500].ClearContents
   
6. Arr = Sheet2.[a1].CurrentRegion
   
7. For i = 2 To UBound(Arr)
   
8.     If Arr(i, 1) <> "CUT-B" And Arr(i, 1) <> "FQC-B" Then
   
9.         x = Split(Arr(i, 1), "-")(0)
   
10.         d(x) = d(x) + Arr(i, 2)
    
11.     End If
    
12. Next
    
13. Arr = [a1].CurrentRegion
    
14. For i = 2 To UBound(Arr)
    
15.     If d.exists(Arr(i, 1)) Then
    
16.         Arr(i, 3) = d(Arr(i, 1))
    
17.     End If
    
18. Next
    
19. [a1].CurrentRegion = Arr
    
20. End Sub
    

复制代码

蓝桥玄霜

请见附件。

misluo

谢谢老师，辛苦咯

jjmysjg

蓝桥玄霜 发表于 2014-1-17 11:10

运行代码，[c2:c500].ClearContents 发黄，不能继续。
我这是否版本不对？

jiminyanyan

jjmysjg 发表于 2018-8-19 09:01
运行代码，[c2:c500].ClearContents 发黄，不能继续。
我这是否版本不对？

Range(“c2:c500”).ClearContents  试试。。。