Excel 2007 VBA 教程
arr1(x, 5) = Join(arr2, \因为数组arr(x,5)是空的，所以又把用Join处理过的arr2数组里的数据又写进arr1(x,5)里
Erase arr2 '清除数据arr2,目的是为了装后面的数据 Next x '
[E1].Resize(Maxrow, 1) = Application.WorksheetFunction.Index(arr1, 0, 5) '利用Index函数又把数据读出来放在单元格E列
'这里有个要注意，那天我问了“守柔”版主，他也是在实践中发现了这个问题，引用的工作表里的数据用Index处理在VBA里不能超过
' 65536行，这个我现在也是卡着的，如果有知道的，可以指导一下，谢谢。 Columns(5).AutoFit 'E列自动适合列宽
MsgBox \用时\秒\显示程序运行用时 End Sub
6. 把A列的内容逗号进行分列
Sub test1() '可能有的学生会说，老鼠老师真傻，这个不是可能用分列实现吗，呵呵，我这里主要是为了讲Split
Dim Myrow As Long, i As Long, arr1, arr2, t As Single '定义相关的变量 t = Timer '开始记时
maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个有数据的单元格的行号 arr1 = Range(\把区域赋给数组arr1 For i = 1 To maxrow '遍历数组arr1的一维
arr2 = Split(arr1(i, 1), \，\按逗号分开，全部赋值给数组arr2
Cells(i, 2).Resize(1, UBound(arr2) + 1) = (arr2) '把数组arr2一次性赋值给相应的单元格
Erase arr2 '清除数组 arr2 Next i
Columns(\自动适合列宽
MsgBox \用时\秒\显示程序运行的时 End Sub
Sub test2() '
Range(\
Columns(\End Sub
Sub test3() '优化代码
Dim Myrow As Long, i As Long, arr1, arr2, arr3(1 To 20000, 1 To 8), t As Single, k As Long '定义相关的变量
t = Timer ''开始记时
maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个有数据的单元格的行号 arr1 = Range(\把区域赋给数组arr1 For i = 1 To maxrow '遍历数组arr1的一维
arr2 = Split(arr1(i, 1), \，\按逗号分开，全部赋值给数组arr2 For k = 0 To UBound(arr2) '遍历数组arr2的成员
arr3(i, k + 1) = arr2(k) '把数组arr2装进一个新的数组Arr3,这里要注意为什么要arr3(i, k + 1)
'因为你的k初始值是0，而你定义arr3(1 To 20000, 1 To 8)的最小下标是从1开始的，所以要加1
Next k '
第 43 页 共 52 页
Excel 2007 VBA 教程
Erase arr2 '清除数组arr2 Next i
Range(\把数组arr3一次性与于单元格区域 Columns(\自动适合列宽
MsgBox \用时\秒\显示程序运行的时 End Sub 7. vlookup
(1). 实例 根据A列的姓名依次显示出它们的底薪
Sub test()
Dim Maxrow As Long, arr, arr1, arr2, arr3 '定义相关的变量
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个有数据的单元格行号 arr3 = Array(\小老鼠\代晓蓉\张三\李诗诗\李飞\马丽\把要查找的数据赋值给数组arr3
arr = Range(\把单元格区域赋值给数组arr
arr1 = Application.WorksheetFunction.VLookup(arr3, arr, 3, 0) ' 利用Vlookup函数查找后得到一个新的数组arr1
'大家要注意，在VBA里，一般情况在工作表它的参数可以用数组，那么在VBA也可以用数组，所以Vlookup第一个参数我放了数组arr3进去了
For i = 1 To UBound(arr1) '和用循环语句把查找的结果用显示函数Msgbox显示出来 MsgBox arr3(i - 1) & \的底薪是\ Next i End Sub
8. 同样的方法我们可以用这几个函数来实现其它的，这里我就不多说了，同学们可以自己去尝试一下。
sumif，small，large，match
二. 实例 查找不及格记录 Sub test()
Dim Maxrow As Long, arr1, arr2(), i As Long, x As Long '定义相关的变量
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个数据的单元格行号 arr1 = Range(\把区域数据装入数组arr1中
For i = 1 To UBound(arr1, 1) '遍历数组arr1中的一维，相当于工作表中的行数 If arr1(i, 4) < 60 Then '如果arr1的值小于60，那么 x = x + 1 '累加x ,起到记数器的作用
ReDim Preserve arr2(1 To 4, 1 To x) '重新定义动态数组arr2,为什么这样定义呢，因为二维动态数组只能更改二维，不能更改一维
'所以把行和列选互换一下，这样就可以把数组arr1中符合条件的装过数组arr2中，处理完后再通过转置函数又要把行和列换回来
arr2(1, x) = arr1(i, 1) ' arr2(2, x) = arr1(i, 2) ' arr2(3, x) = arr1(i, 3) ' arr2(4, x) = arr1(i, 4) ' End If ' Next i
[F1:I1] = Array(\学号\姓名\性别\成绩\把标题写在单元格区域F1:I1
[F2].Resize(UBound(arr2, 2), 4) = Application.WorksheetFunction.Transpose(arr2) '把数组arr2成员一次性写于单元格区域 '不过这里一定要注意，满足要求的，也就是说不及格的人数，是用UBound(arr2, 2)，不是Bound(arr2, 1)
第 44 页 共 52 页
Excel 2007 VBA 教程
'如果是用1，arr2数组的一维的上界是4，重新定义数组已经申明了，所以是用2，数组arr2二维的上界才是不及格的人数 End Sub
第十五讲 字典基础知识（一）
一. 申明（大家不要以为佛山小老鼠是用字典高手，我也还是菜鸟，呵可，记住，不要拿字典来考我，我是把学
字典的一点心得分享，希望能帮到比我还菜的VBA 爱好者。）
二. 开头白：字典，早一年，我刚按触VBA的时候，看到别人写的一些代码怎么也看不懂，后来听别人说，一是
Vba里的数组，还有就是字典，这两个知识点可以优化代码和提高代码的运行速度，于是，我也蠢蠢欲动，可以怎么也不明白。于是放弃了学习VBA，因为自己会写代码，也是一些简单的录制宏，修改宏，最多也只能用上循环语句。很羡慕VBA高手写的那些长长的代码，那天我的水平有这么高就好了，然后我到ExcelHome论坛上找了这方面的资料，如“山菊花老师的墙上那一串串红辣椒——数组入门讲座”，“蓝桥玄霜老师：常见字典用法集锦及代码详解”，以及“蓝色幻想”老师的一些视频和贴子，真的很感谢这些老师，总算把我这个菜鸟带入了门
1. 字典的引用方式
(1). 前期绑定：方法——>>Alt+F11——>>工具菜单——>>引用——>>浏览——>>选择scrrun.dll。如图
26
a. 优点：对于刚学习字典的朋友好，可以弹出成员列表出来。
b. 缺点：把文件发给别人，别人如果不引用下面这个动态Dll文件就不能用这段代码
图 26
(2). 后期绑定 要用代码实现
方法
Set dic= CreateObject(\
a. 优点：可以发给别人使用，不要担心不能用了 b. 缺点：不利用编程人员编辑代码
(3). 备注：有时可能还是用不了，Windows的开始——>>运行——>>输入Regsvr32 Scrrun.D11——>>
确定，如果还是失败，那么说明你的电脑没有这个动态库Scrrun.D11，这时你到网上去下载这个，或者你别人的电脑上复制过来这个Scrrun.D11，然后放在C:\\WINDOWS\\system32文件夹下，再进行上面的注册，Windows的开始——>>运行——>>输入Regsvr32 Scrrun.D11——>>确定
三. 字典的优势
1. 字典可以创建二列的二维数组，更加灵活
第 45 页 共 52 页
Excel 2007 VBA 教程
(1). 如果工作表有多列，大家可以用“&”把它们连接起来，再装进字典里 2. 字典的一些属性可读可写
(1). Key和Item可读可写
(2). Keys和Items方法可以转为一维数组，然后再通过转置函数Transpose转为纵向写于单元格 3. 字典里Key关键字具有唯一性
(1). 可以用来去重复值 (2). 可以用来分类汇总
4. 具体我们到后面的实例去了解 四. 向字典里装入数据
1. 前期绑定的装入见实例
Sub test() '这是前期绑定的，方法工具菜单-->>引用-->>浏览-->>选择scrrun.dll-->>打开
Dim dic As New Dictionary, arr, arr1, arr2, Maxrow As Long, i As Long, x As Long '定义相关的变量 Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后有数据的单元格的行号 arr = Range(\把区域转为二维数组 For i = 1 To UBound(arr, 1) '遍历数组arr里一维
dic.Add arr(i, 1), arr(i, 2) '把数组arr里的成员装入字典 Next i
arr1 = dic.Keys '因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了 arr2 = dic.Items '
For x = 1 To dic.Count - 1 '本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头
MsgBox arr1(x) & \的底薪是\通过循环依次显示结果 Next x End Sub
2. 后期绑定的装入
Sub test() '这是后期绑定的
Dim dic As Object, arr, arr1, arr2, Maxrow As Long, i As Long, x As Long '定义相关的变量 Set dic = CreateObject(\
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后有数据的单元格的行号 arr = Range(\把区域转为二维数组 For i = 1 To UBound(arr, 1) '遍历数组arr里一维
dic.Add arr(i, 1), arr(i, 2) '把数组arr里的成员装入字典 Next i
arr1 = dic.Keys '因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了 arr2 = dic.Items '
For x = 1 To dic.Count - 1 '本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头
MsgBox arr1(x) & \的底薪是\通过循环依次显示结果 Next x End Sub
五. 从字典中读中数据
1. 实例 去重复值
Sub test() '没有用防错语句
Dim dic As Object '定义变量
第 46 页 共 52 页
Excel 2007 VBA 教程
Set dic = CreateObject(\引用字典
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个有数据单元格的行号 arr = Range(\把单元格区域数据装入二组数组arr里
For i = 1 To UBound(arr) '遍因数据arr的一维，相当于遍历单元格区域的行
dic(arr(i, 1)) = \把数组成员一一加入字典里，Item没有我们就把它等于空，也就是只装了字典的Key
'这种表达方，如果有重复就会覆盖，不会报错，如果用Add的方法就要在前面加一句On error resume next Next i
[B1].Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.Keys) '
'因为dic.keys和dic.items得到都是一维数组，且下标从0开始的，所以要用转置函数 End Sub
Sub test1() '用防错语句
Dim dic As Object '定义变量
On Error Resume Next '屏蔽添加重复的报错
Set dic = CreateObject(\引用字典
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后一个有数据单元格的行号 arr = Range(\把单元格区域数据装入二组数组arr里
For i = 1 To UBound(arr) '遍因数据arr的一维，相当于遍历单元格区域的行
dic.Add arr(i, 1), \把数组成员一一加入字典里，Item没有我们就把它等于空，也就是只装了字典的Key
'这种表达方，如果有重复就会会报错，就要在前面加一句On error resume next Next i
[B1].Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.Keys) '
'因为dic.keys和dic.items得到都是一维数组，且下标从0开始的，所以要用转置函数 End Sub
备注：直接读取用了dic.Keys和dic.Items，如果要循环，那么就要倒传一下，绕过圈，先把dic.Keys和dic.Items赋给数组，也就是装进数组，然后循环数组，因为不能这样引用dic.Keys（0）
六. 修改字典里的数据 可以直接用dic(\关键字\“某一个值”，这“某一个值”就是条目对了
Sub test() '修改字典里的数据
Dim dic As Object, arr, arr1, arr2, Maxrow As Long, i As Long, x As Long '定义相关的变量 Set dic = CreateObject(\
Maxrow = Cells(Rows.Count, 1).End(xlUp).Row '取得A列最后有数据的单元格的行号 arr = Range(\把区域转为二维数组 For i = 1 To UBound(arr, 1) '遍历数组arr里一维
dic.Add arr(i, 1), arr(i, 2) '把数组arr里的成员装入字典 Next i
'dic(\小老鼠\然后我们又把这一句前面加一个逗号去掉让运行看看，发现前面一次1000，去掉逗号之后是999，可以直接用dic(\关键字\“某一个值”，这“某一个值”就是条目对了 arr1 = dic.Keys '因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了 arr2 = dic.Items '
For x = 1 To dic.Count - 1 '本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头
MsgBox arr1(x) & \的底薪是\通过循环依次显示结果
第 47 页 共 52 页