.本文转载自公众号:哆哆数学,原创作者:fs哆哆老师。本文著作权归原创作者所有,本人收藏此文仅作为学习之用,不作其他目的,如有侵权,请联系我删除。 ====字典绑定=== Sub 前期绑定() Dim dic As New Dictionary End Sub sub 后期绑定() Dim dic Set dic= CreateObject('Scripting.Dictionary') End Sub ===字典的6个方法4个属性=== dic.Add '添加关键词,方法 dic.CompareMode = 1'不区分大小写,如果等于0区分大小写 dic.Count '数字典里的关键词有多少个 dic.Exists '判断关键词在字典里是否存在 dic.Item '是指条目 dic.Key '是指关键词 dic.Items '可以返回所有条目的集合,也可以说返回一个从0开始编号的一维数组,是方法,大家不要理解为属性,不能当作对象 dic.Keys '可以返回所有的关键字词集合,也可以说返回一个从0开始编号的一维数组,也是方法 dic.Remove '清除某一个关键词 dic.RemoveAll '清除全部关键词,而数组只能清除数组的值,但不是不能清数组空间结构 . 【问题】一个级的成绩,我想按班别拆分为各个班的成绩各一个工作表 Sub 字典拆分() Dim active_sht As Worksheet, rng As Range Set dic = CreateObject('scripting.dictionary') title_row = 2 f_col = 4 Set active_sht = Worksheets('汇总') With active_sht endRow = .Cells.Find('*', .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row '计算最后一个工作表的非空行号 endCol = .Cells.Find('*', .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column '计算最后一个工作表的非空列号 ' MsgBox '行:' & endRow & Chr(10) & '列:' & endCol 'Debug.Print arr = .Range(.Cells(1, f_col), .Cells(endRow, f_col)) For i = title_row 1 To UBound(arr) If Not dic.exists(arr(i, 1)) Then Set dic(arr(i, 1)) = Union(.Range(.Cells(1, 1), .Cells(title_row, endCol)), .Cells(i, 1).Resize(1, endCol)) Else Set dic(arr(i, 1)) = Union(dic(arr(i, 1)), .Cells(i, 1).Resize(1, endCol)) End If 'MsgBox i Next i End With With Worksheets('Sheet2') .Range('a1').Resize(dic.Count, 1) = Application.Transpose(dic.keys) End With For j = 0 To dic.Count - 1 Worksheets.Add after:=Worksheets(Sheets.Count) ActiveSheet.Name = dic.keys()(j) With ActiveSheet dic.items()(j).Copy .[a1] End With Next j End Sub . . =====今天再一次练习一下字典的用法==== |
|