ExcelVBA字典用法之按列拆分工作表题
VBA字典基本知识
====字典绑定===
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
=====今天再一次练习一下字典的用法====
