曾经的回帖整理-字典案例部分

liulang0808

使用字典+goto语句，进行穷举，有兴趣的可以参考附件案例

liulang0808

今天刚回复的帖子

擎、天

目测此贴会火，先占个位置 学习

liulang0808

以E列名称为关键字，汇总各个工作薄A列的数量

1. Sub 合并当前目录下所有工作簿的全部工作表()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set fso = CreateObject("scripting.filesystemobject")
   
4.     Application.ScreenUpdating = False
   
5.     Set sh = ActiveSheet
   
6.     arr = sh.UsedRange
   
7.     For j = 2 To UBound(arr)
   
8.         d(arr(j, 2)) = arr(j, 1)
   
9.     Next j
   
10.     For Each f In fso.getfolder(ThisWorkbook.Path).Files
    
11.         If InStr(f.Name, "汇总表") = 0 Then
    
12.             With Workbooks.Open(f)
    
13.                 arr = .Sheets(1).UsedRange
    
14.                 .Close False
    
15.             End With
    
16.             For j = 3 To 20
    
17.                 d(arr(j, 5)) = d(arr(j, 5)) + arr(j, 1)
    
18.             Next j
    
19.         End If
    
20.     Next f
    
21.     sh.[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
    
22.     sh.[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

liulang0808

从N列组合中，选取部分

1. Public d
   
2. Public r
   
3. Public arr
   
4. Public m
   
5. Sub lqxs_zd()
   
6.     Application.ScreenUpdating = False
   
7.     Sheets("code").UsedRange.ClearContents
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     arr = Sheets(1).[a1].CurrentRegion
   
10.     m = 7
    
11.     r = 1
    
12.     For j = 1 To UBound(arr, 2)
    
13.    
    
14.         d(j) = j
    
15.         dg j
    
16.         a = d.Count
    
17.         d.Remove j
    
18.     Next j
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    
21. Sub dg(y)
    
22.     For j = y + 1 To UBound(arr, 2)
    
23.         d(j) = j
    
24.         If d.Count = m Then
    
25.             For i = 0 To 6
    
26.                 Sheets(1).Cells(1, d.keys()(i)).Resize(7).Copy Sheets(2).Cells(r, i + 1)
    
27.             Next i
    
28.             r = r + 7
    
29.         Else
    
30.                 dg j
    
31.         End If
    
32.         If d.exists(j) Then d.Remove j
    
33.     Next j
    
34. End Sub
    

复制代码

不笑猫-v

大牛呀。。。。。。好多代码实例。

liulang0808

根据AB两列，对后面的数据进行汇总

赵莲

留下脚印，慢慢学习

blackttea1

版主辛苦了，感谢分享！

汝愿

感谢版主，精彩奉献