Excel_VBA 从入门到精通必备

Excel VBA 程序开发自学通 2020 4 5 第 1 页 共 513 页 为入门篇 VBA 优势 功能与概 念 第一章 从 Excel 插件认识 VBA 简单的说 Excel VBA 是依附于 Excel 程序的一种自动化语言 它可以使常用的 程序自动化 类似于 DOS 磁盘操作系统 中的批处理文件 后缀名 bat 那么 它有什么具体的功能 在工作中与常规操作方式相比 具有哪些优势 笔者试图通 过一个简单却实用的插件来展现 本章要点 从身份证号获取个人信息 在工作中如何发挥 Excel 插件的优势 1 1 从身份证号获取个人信息 制作人事资料时 通常需要录入职员身份证号码 以及生日 年龄 性别等等 除身份证号码需要手工逐一录入以外 其它三项信息的录入有四种方法 手工录入 内置公式 自定义函数法 插件法 手工输入方式效率极差 且出错机率也最高 本节通过后三种方式来实现并比较 从而让读者对 VBA 之优势与用法得以初步认知 1 1 1 常规公式法 以图 1 1 数据为例 利用公式从身份证中提取生日 年龄 性别等信息 可以有 多种方法 本例列举其中之一 图 1 1 根据身份证号提取职工年龄 生日与性别 通过公式计算职工的年龄 出生日期与性别 步骤如下 Excel VBA 程序开发自学通 2020 4 5 第 2 页 共 513 页 1 在单元格 C3 输入以下公式 用于计算年龄 DATEDIF DATE MID B3 7 4 LEN B3 15 2 MID B3 11 LEN B3 15 2 2 MID B3 13 LEN B3 15 2 2 NOW Y 2 在单元格 D3 输入以下公式 用于计算出生日期 TEXT RIGHT 19 SUMS Debug Print A1 A10 中文本为 MYSTR End Sub 3 使用快捷键 Ctrl G 显示立即窗口 4 光标定位于代码中任意位置并按下快捷键 F5 执行代码后在立即窗口 将显示图 5 2 所示的结果 图 5 1 工作表数据 图 5 2 统计结果 从这个程序过程可以得出以下结论 1 本序中使用了四个变量 分别对应四种数据类型 表 5 1 变量与数据类型 变量 数据类型 Sums Long Cell Range I Byte Mystr String Excel VBA 程序开发自学通 2020 4 5 第 61 页 共 513 页 2 本例中所使用的四种数据不可以互换 任何两个变量的数据类型都无法互 换 每个变量都使用了合适的数据类型 用其中 Sums 变量的值较大 选中 Long 型 可以储存 2 147 483 648 到 2 147 483 647 之间的数据 而 Cell 变量代表单元格 则 必须使用 Range 对象类型 变量 I 在 1 到 10 之间变化 所以可以用最范围偏小的 Byte 而 Mystr 变量是文字串 那么只能用 String 3 如果本例不声明所有变量的数据类型 程序执行效率会有所下降 尽管下 降不多 5 1 3 数据类型的声明与转换 认识数据的类型 占用空间及定义数据类型的重要性后 就可以在程序中声明 变量的数据类型了 声明数据类型使用 As 语句 在 As 之后直接附上数据类型即可 中间用空格分 隔 例如 Dim a as Byte 数据类型不区分大小写 不管用 BYTE Byte 还是 byte 都可以 但 VBA 会自动将录入数据类型转换成首字母大写 其它字符小写的格式 如果不指定数据类型 则 VBA 自动将变量指定为变体型 Variant 即以下两句 代码具有相同的作用 Dim i Dim I as Variant 变量的数据类型根据需要也可以转换 即在声明数据类型时若使用了占用内存 较大的数据类型 而在某个阶段所获取的值却很小 当用这个很小的数据去参数计 算时 就有必要将该数据转换成占用内存更小的数据类型 例如 Sub test Dim 成绩 As Long 成绩 80 中间代码 利用变量 成绩 参与各种运算 End Sub 在以上代码 变量 成绩 的类型是占用 4 字节的 Long 型 但事实上它的值为 80 那么利用变量 成绩 参与后续的各种运算将浪费内存 而将其转换成 Byte 型 再参与运算 则可以提速 体现出类型转换之现实意义 从另一个角度考虑 因不同的数据类型对小数处理的精度不同 那么数据转换 后可以实现更符合需求的精度 可用于数据类型转换的函数见表 5 2 所示 表 5 2 数据类型转换函数列表 函数 返回类 型 expression 参数范围 CBool Boolean 任何有效的字符串或数值表达式 CByte Byte 0 至 255 CCur Currency 922 337 203 685 477 5808 至 922 337 203 685 477 5807 CDate Date 任何有效的日期表达式 CDbl Double 负数从 1 79769313486231E308 至 4 94065645841247E 324 正数从 4 94065645841247E 324 至 1 79769313486232E308 Excel VBA 程序开发自学通 2020 4 5 第 62 页 共 513 页 CDec Decimal 零变比数值 即无小数位数值 为 79 228 162 514 264 337 593 543 950 335 对于 28 位小数的数值 范围 则为 7 9228162514264337593543950335 最小的可能非零值是 0 0000000000000000000000000001 CInt Integer 32 768 至 32 767 小数部分四舍五入 CLng Long 2 147 483 648 至 2 147 483 647 小数部分四舍五入 CSng Single 负数为 3 402823E38 至 1 401298E 45 正数为 1 401298E 45 至 3 402823E38 CStr String 依据 expression 参数返回 Cstr CVar Variant 若为数值 则范围与 Double 相同 若不为数值 则范围与 String 相同 除上面的转换函数外 还有一个用于识别数据类型的函数 TypeName 功能 返回一个 String 提供有关变量的信息 语法 TypeName varname 如判断一个数据或者变量是何数据类型 可以用以下语句 Msgbox Typename 10 返回 Integer VBA 自动分配的类型 Msgbox Typename 65536 返回 Long Msgbox Typename a1 返回 Range Msgbox Typename Mystr 在未对变量赋值的状态下返回 Empty 如果利用表 5 2 中的函数对变量进行转换 那么 Typename 返回值会相应变化 变量本身的值也可能变化 Sub 类型转换 Dim funds As Double funds 80 42454 MsgBox 类型 1 2 3 4 5 7 1 2 3 4 5 6 7 1 DATE y m 1 WEEKDAY DATE y m 1 1 0 1 2 3 4 5 7 1 2 3 4 5 6 7 1 d 将公式中的辅助字符替换 Replace What m Replacement MONTH bmp png gif jpg bmp png gif 让用户选择待插入的文件 只能单选 filennames Application GetOpenFilename filefilter1 请选一个图片文件 MultiSelect False Excel VBA 程序开发自学通 2020 4 5 第 322 页 共 513 页 插入该图片 然后设置其上边距 左边距 宽度与高度皆与选区一致 With ActiveSheet Pictures Insert filennames Top ActiveCell Top ShapeRange LockAspectRatio msoFalse Width Selection Width Left ActiveCell Left Height Selection Height End With End Sub 以上过程中使用了 GetOpenFilename 来获取图片文件名 然后根据图片文件全 名插入该图片工作表 而不是使用插入图片的对话框 Application Dialogs 342 这是 因为插入图片的对话框无法限制用户一次只能插入一张图片 而且插入后的图片不 便于控制 GetOpenFilename 方法的优点在于随心所欲地定制文件格式 且插入后扔 的图片也可以随心所欲控制它 3 返回工作表 选择 B2 E5 区域 然后使用快捷键 Alt F8 打开 宏 对 话框 选择并执行 插入图片且等于选区大小 程序将弹出一个 请选择一个图片 文件 的对话框 它支持 png jpg gif 和 bmp 四种格式的图片文件 见图 11 56 所 示 从打开的对话框中任意选择一张图片 然后程序会将该图片插入到当前表 当 其上边距 左边距以及高度 宽度都是与选区一致 图 11 57 是选择的区域 而图 11 58 是插入图片后的效果 它刚好适应选区 如果用户选择的是一个单元格 那么 图片也会刚好嵌入该单元格中 图 11 56 选择图片文件 Excel VBA 程序开发自学通 2020 4 5 第 323 页 共 513 页 图 11 57 选择单元格 图 11 58 插入图片覆盖选区 语法补充 1 Range Top 属性返回或设置单元格的上边距 以磅为单位 而 Range Left 属性返回或设置单元格的左边距 以磅为单位 2 Range Width 属性返回一个区域的宽度 以磅为单位 Range Height 属性 返回一个区域的高度 以磅为单位 3 Application GetOpenFilename 方法可以显示一个标准的 打开 对话框 并获取用户文件名 它的语法如下 Application GetOpenFilename FileFilter FilterIndex Title ButtonText MultiSelect 其中五个参数的含义如下 表 11 27 Application GetOpenFilename方法含义详解 名称 描述 FileFilter 一个指定文件筛选条件的字符串 FilterIndex 指定默认文件筛选条件的索引号 取值范围为 1 到由 FileFilter 所指定的筛 选条件数目 如果省略该参数 或者该参数的值大于可用筛选条件数 则使 用第一个文件筛选条件 Title 指定对话框的标题 如果省略该参数 则标题为 打开 ButtonText 仅限 Macintosh MultiSelect 如果为True 则允许选择多个文件名 如果为False 则只允许选择一个文件名 默认值为False Application GetOpenFilename 的一个极大的优点是可以任意筛选文件格式 也可 以任何组合多种格式的文件 本例中默认显示四种格式的图片 如果需要分开显示 即一次筛选一种格式的图片 那么可以按以下方式设置筛选条件 filefilter1 位图 bmp bmp jpg 图片 jpg jpg png 图片 png 9 png Gif 动画 gif gif 设置效果如下 显示为四种格式 默认显示第一种 而对话框中显示的图片也 根据用户选择的文件类型而变化 图 11 59 显示四种格式的图片 如果需要既显示多个选项 其中某个选项又可以包含多种格式 那么需要对包 含多种格式的选项利用分号连接 而且同时可以修改 Application GetOpenFilename 的第二参数设置默认选项为 2 例如以下代码可以产生图 11 60 中的效果 filefilter1 位图 bmp bmp 其它图片 jpg png jpg pgn Gif 动画 Excel VBA 程序开发自学通 2020 4 5 第 324 页 共 513 页 gif gif 图 11 60 显示三个选项共五种格式的文件 11 2 15 选择当前表已用区域的奇 偶数行 案例要求 选择当前表已用区域的奇 偶数行 由用户指定是奇数还是偶数 知识要点 Columns Rows 实现步骤 1 单击菜单 插入 模块 2 在模块代码窗口输入以下代码 Sub 选择奇偶数行 Dim i As Integer rng As Range Ji Ou As Byte On Error Resume Next Star 设定一个标签 当程序出错时返回此处 指定奇偶 Ji Ou Application InputBox 输入 1 选择奇数行 bmp jpg bmp 如果未选择图片则退出 IF Pict False Then End 添加批注 With ActiveCell AddComment Visible False 隐藏批注 Shape Fill UserPicture Pict 填充图片 Shape Height 100 高度为 100 Shape Width 120 高度为 120 End With End Sub 以上过程首先清除批注 然后由用户选择图片 最后将图片加入批注中 批注 的大小可以调整 3 返回工作表 使用快捷键 Alt F8 打开 宏 对话框 选择并执行 插 入图片标注 后如果当前单元格有批注 那么会清除原有的批注 然后弹出一个对 话框由用户选择图片 支持 BMP 和 JPG 两种格式 最后产生的效果如图 11 100 所 示 图 11 100 插入图片批注 语法补充 1 Comment Shape 属性返回一个 Shape 对象 它代表连接到指定批注的形状 2 Shape 对象可使用 Fill 方法设置其填充颜色或者图片 图片可以使用任何 有效的图片格式 但如果使用 GIF 动画 则不会产生动画效果 11 4 4 添加个性化批注 案例要求 添加外观更具个性的批注 提供多种形状可选 知识要点 Select 实现步骤 1 单击菜单 插入 模块 2 在模块代码窗口输入以下代码 Sub 添加个性化批注 Dim mystr As String mystr2 As String Comment As Comment 清除原有批注 ActiveCell ClearComments 让用户输入批注内容 默认值为用户名 mystr InputBox 输入批注内容 批注 Application UserName 10 10 让用户选择批注的形状 有 22 种可选项 Excel VBA 程序开发自学通 2020 4 5 第 353 页 共 513 页 mystr2 InputBox 输入批注外形 bmp jpg bmp 如果未选择图片则退出 IF Pic False Then End 为当前表设置背景图片 ActiveSheet SetBackgroundPicture Filename Pic Set rng ActiveSheet UsedRange 将多余的列设置为白色 Range Cells 1 Range a1 rng Columns Count 1 Cells 1 Columns Count En tireColumn Interior ColorIndex 2 将多余的行设置为白色 Rows Range a1 rng Rows Count 1 C 成绩表 txt Destination ThisWorkbook Sheets 3 Range A 1 以逗号进行分列 TextFileCommaDelimiter True 更新外部数据 Refresh BackgroundQuery False End With End Sub 3 返回工作表 使用快捷键 Alt F8 打开 宏 对话框 选择并执行 导 入文件且以逗号分列 那么 C 盘中名为 成绩表 txt 的文本文件中的数据将瞬间 导入到当前工作表簿第三个工作表中 图 11 122 和图 11 123 是文本文件内容导入到 Excel 后的显示状态 图 11 122 文本文件 11 123 导入文本文件到工作簿 语法补充 1 Workbook Sheets 属性返回一个 Sheets 集合 它代表指定工作簿中所有工 作表 利用参数 Item 可以访问其它某个工作表 例如 Worksheets Book1 Sheets 2 表示 Book2 工作簿中第二个工作表 ActiveWorkbook Sheets 2 表示当前活动工作表中名为 2 的工作表 而非第 2 个工作表 ThisWorkbook Sheets Date G 通用格式 Else MsgBox 请选择区域 64 提示 End IF Case 3 输入 3 则将零值替换成空白 Excel VBA 程序开发自学通 2020 4 5 第 402 页 共 513 页 Cells Replace 0 xlWhole End Select End Sub 3 选回工作表 使用快捷键 Alt F8 打开 宏 对话框 选择并执行 不 显示零值 将弹出图 11 146 所示对话框 让用户选择对零值的处理方式 如果选择 1 那么当前表所有零值都会隐藏起来 编辑栏中可以看到 单元格中不显示 见 图 11 147 所示 如果选择 2 那么只隐藏选择区域的零值 如果选择 3 则删除所有 当前工作表中的零值 单元格中和编辑栏中都不显示 见图 11 148 所示 图 11 146 选择零值处下方式 图 11 147 隐藏零值 图 11 148 删 除零值 语法补充 1 Window DisplayZeros 属性表示零值的显示方式 则为属性值 True 则显示 零值 否则隐藏零值 它的设置仅对当前工作表生效 其它工作簿或者工作表需要 再设置 2 本例中的三种方式各有优势 第一种方式对整个工作表生效 仅改变显示 值 不改变实际值 随时可以撤消隐藏设置 第二种方法对可以对选定的任意区域 设置隐藏 而且也方便取消零值的隐藏 但如果选择已有部分单元格有自定义数字 格式将破坏原有设置 第三种方式删除所有零值单元格 无法还原 虽然可以定位 空单元格 再输入 0 值 然而却可以将原来的空单元格也意外的加入 0 本例文件参见光盘 第十一章 三种方法不显示零值 xlsm 第十二章 Excel 的事件应用案例 Excel 的事件可以让程序自动执行 或者基于某个条件下自动执行 不需要用户 手工引导 这使事件过程在工作中得到了广泛的应用 在本书第八章中介绍了事件的基本知识 然后通过第九章 十章和十一章地学 习 已经常握代码编写规则 常见语句的语法 以及对 Excel 的对象应用有了较深入 地认识 那么现在足以编写 Excel 事件的实例应用程序了 本章对 Excel 事件将进行 全面地高级应用案例演示 让读者加深对事件的理解及提升对象及事件的驾驭能力 本章要点 应用程序事件案例 工作簿事件案例 工作表事件案例 ActiveX 控件事件案例 Excel VBA 程序开发自学通 2020 4 5 第 403 页 共 513 页 12 1 应用程序事件案例 应用程序级别的事件对所有工作簿 工作表和单元格都生效 编写应用程序级 别事件时需要用到类模块的知识 12 1 1 新工作簿环境设计 案例要求 每次新建工作簿时 默认有 7 个工作表 第一个工作表名为 总表 其它表名为分表 实现步骤 1 新建工作簿 使用快捷键 Alt F11 进入 VBE 界面 2 单击菜单 插入 模块 3 在模块中录入以下代码 Dim xlapp As New appevents 声明一个对象 Sub auto open 工作表开启时执行 Set xlapp app Application 将应用程序赋与对象变量 End Sub Sub auto close Set xlapp app Nothing 释放变量 End Sub 4 单击菜单 插入 类模块 5 单击快捷键 F4 打开属性窗口 将类模块的默认名 类 1 修改为 appevents 6 在类模块中输入以下代码 Public WithEvents app As Application 声明可触发事件的对象变量 Private Sub app NewWorkbook ByVal Wb As Workbook 声明应用程序事件 Dim i As Byte Wb Sheets Add 7 Sheets Count 创建 4 个工作表 默认有 3 个 Wb Sheets 1 Name 总表 将第一个命名为总表 For i 2 To Wb Sheets Count 从第二开始 直到最后一个 Wb Sheets i Name 分表 2 3 4 5 6 Excel VBA 程序开发自学通 2020 4 5 第 430 页 共 513 页 图 13 1 一维横向数组公式 图 13 2 一维纵向数组公式 VBA 中的数组也可以像上图中的工作表数组公式一样表示横向和纵向的一维数 组 例如 1 2 3 5 6 表示一维横向数组 验证它是否一维横向数组的最好办法是将它赋值给一相同大小的单元格区域 代码如下 Sub 赋值 a1 f1 1 2 3 4 5 6 End Sub 当执行以上过程后 可以得到图 13 1 的结果 那么 1 2 3 4 5 6 是一维横向数 组 1 2 3 4 5 6 表示一维纵向数组 同样可以借用区域赋值的方式验证 Sub 赋值 b1 b6 1 2 3 4 5 6 End Sub 以上过程可以获得与图 13 2 所示同样的效果 同时 根据以上两个赋值的过程 我们可以看到数组在 VBA 中的优势 即不需 要对单元格循环赋值 可以将原本需要循环 6 次的操作集中在一次完成赋值 2 二维数组 图 13 3 中 B1 E4 是四行四列的区域 利用工作表数组公式对这个区域赋值可以 使用以下公式 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 图 13 3 二维数组 在 VBA 中也可以利用数组表示是一个二维数组 例如 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 四行四列的二维数组 执行以下过程可以完成图 13 3 所示效果 Sub 赋值 b1 e4 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 End Sub Excel VBA 程序开发自学通 2020 4 5 第 431 页 共 513 页 13 1 3 利用索引号获取数组中的元素 类似于 Range 可以使用索引号访问区域中的每一个单元格一样 一维数组和二 维数组也可以利用索引号获取数组中的每一个值 它主要有两种形式 Arr Item Arr RowIndex ColumnIndex 这两种方式在形式上看与 Range 的索引号完全一致 然而事实上却存在很多差 异 在 Range 中 不管是一维区域还是二维区域都可以利用以上任何方式访问区域 中的单元格 例如 MsgBox Range A1 A20 7 Address 0 0 MsgBox Range A1 A20 3 1 Address 0 0 MsgBox Range A1 D20 7 Address 0 0 MsgBox Range A1 A20 4 2 Address 0 0 以上四种方式访问区域中某个单元格地址都正确 但数组中却不能混用 当数 组是一维时 只能利用第一种方式访问数组中的元素 而数组是二维时 则只能利 用第二种方式访问其中每个元素 例如以下的过程中 对一维数组的两种索引方式 只能前者可以正常执行 后者会产生错误 Sub 利有用索引号引用数组中的元素 Dim arr1 声明数组变量 arr1 Array 甲 乙 丙 丁 对数组赋值 MsgBox arr1 1 正确的引用 MsgBox arr1 1 1 错误的引用 End Sub 对于二维数组 以下两种索引方式也只能第一种方式正确 后者会产生运行时 错误 Sub 利有用索引号引用数组中的元素 Dim arr1 声明数组变量 arr1 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 对数组变量赋值 MsgBox arr1 3 2 取值 正确的引用方式 MsgBox arr1 7 取值 错误的引用方式 End Sub 当使用索引号引用数组中的无素时 有一个很重的设置需要注意 第一个元 素的默认索引值 在默认状态下 如果模块中未指定第一个元素的索引号 那么默认为 0 即数组 arr 中的第一个值用 arr 0 表示 最后一个元素的索引号则为数组元素个数减 1 来表 示 所以下面的过程中 如果未指定第一个元素的默认索引值 那么结果为 乙 而非 甲 Sub 利有用索引号引用数组中的元素 Dim arr1 声明数组变量 arr1 Array 甲 乙 丙 丁 对数组赋值 MsgBox arr1 1 正确的引用 End Sub 如果不习惯这种默认的索引方式 VBA 提供了专用的语句改变第一个元素的索 引号 Option Base 语句 Option Base 1 表示数组中第一个元素的索引号为 1 Excel VBA 程序开发自学通 2020 4 5 第 432 页 共 513 页 Option Base 语句只能置于模块的顶部 而且可选值只有 0 和 1 因为默认状态 即为 0 那么需要 Option Base 0 时可以忽略 Option Base 语句仅仅作用于当前模块 如果需要修改第一元素默认索引号为 1 时 需要所有模块都使用该语句 13 1 4 声明数组与赋值 数组与其它变量一样 需要声明后再使用 犹其是数组更需要显示声明 1 声明数组变量 声明数组和其它变量一样 可以使用 Dim Static Private 或 Public 语句来声明 标量变量 非数组 与数组变量的不同在于通常必须指定数组的大小 若指明数组 的大小 则它是固定大小数组 若程序运行时数组的大小可以被改变 则它是个动 态数组 在声明数组变量时 可以指定数组的第一元素索引号 也可以指定数组的维数 当数组变量的参数是一个数值时 表示它是一维横向数组 元素个数等于该值 加 1 例如 Dim arr 5 表示声明一个具有 6 个元素的横向一维数组 其数据类为变体 Variant Dim arr 4 as byte 表示声明一个具有 5 个元素的横向一维数组 其数据类为 Byte 如果借用 To 关键字 可以指定数组中第一个元素的索引值 例如 Dim arr 1 To 3 As String 表示声明一个具有 3 个元素的一维横向数组 数据 类型为 String 其第一元素的索引号为 1 如果需在声明二维数组 可以使用逗号将参数分开 其形式为 arr 一维 二维 例如 Dim arr 3 2 As String 表示声明一个 4 行乘 3 列的二维数组 默值第一元素 索引值为 0 Dim arr 1 To 3 1 To 2 As String 表示声明一个 3 行乘 2 列的二维数组 默认 第一元素索引值为 1 VBA 允许一个二维数组中不同维的第一元素索引值不同 例如 Dim arr 1 To 4 2 As String 表示 4 行乘 3 列的二维数组 第一维中第一元素 的索引值是 1 而第二维中第一元素的索引值是 0 2 对数组变量赋值 相对于标量变量赋值 对数组变量赋值的方式更复杂 因为数组是多个元素的 集合 数组赋值通常采用三种方式 利用循环逐个赋值 利用 Array 对一维数组变量 赋值 直接将区域赋与数组 以下过程是对数组逐个赋值 最后输入数组中第三个元素 Sub 数组赋值 Dim arr 3 As String Item Excel VBA 程序开发自学通 2020 4 5 第 433 页 共 513 页 循环数组的四个元素 For Item 0 To 3 逐个赋值 将 A1 A4 的值赋与每个变量 arr Item Cells Item 1 1 Next MsgBox arr 2 验证数组中的值 End Sub 以下过程是将一个数组一次性赋值给变量 但是声明变量时必须使用变体型 Variant Sub 数组赋值 Dim arr As Variant 必须用变体型 一次性对数组赋值 横向一维数组 arr Array 甲 乙 丙 丁 MsgBox arr 2 验证数组中的值 End Sub 以上方式赋值时 数组 arr 的第一元素默认索引号为 1 也可以对一维纵向数组赋值 Sub 数组赋值 Dim arr As Variant 必须用变体型 一次性对数组赋值 arr WorksheetFunction Transpose Array 甲 乙 丙 丁 a1 a4 arr 验证 将数组的值导出到 A1 A4 End Sub 直接将区域的值赋与变量也是工作中较常见的赋值方式 例如在区域中循环 查找某个字符串 速度远远低于在内存中查找某字符串 此时通常将区域赋与数组 然后在数组中进行查找 下例中即为将区域的值赋与数组 Sub 数组赋值 Dim rng rng ActiveSheet UsedRange Value End Sub 如果需要从数组变量中取值 可以使用 MsgBox rng 2 3 但不能使用 MsgBox rng 2 这种形式取值 提示 数组的维数一旦在声明时指定 就不能再改变 如果声明是不确定维数组 则需要声明 为动态数组 13 1 5 静态数组与动态数组 静态数组在执行期间不可改变其上界 最后一个元素的索引号 而动态数组可 以随时修改其上界 静态变量的声明方式前面已经讲过 声明变量时指定其大小即可 例如 Dim arr 3 As Long Dim arr2 4 1 1 To 5 As Byte 而声明动态的数组时 需要 Dim 语句配合 ReDim 语句或者 ReDim Preserve 语句 来实现 ReDim 语句或者 ReDim Preserve 语句的作用是为动态数组变量重新分配存 储空间 包括指定维数及声明其上界 但 ReDim 语句重置数组大小时 会使数组中 Excel VBA 程序开发自学通 2020 4 5 第 434 页 共 513 页 的值丢失 而 ReDim Preserve 语句重置数组的大小时可以保留原数组中的值 可以使用 ReDim 语句反复地改变数组的元素以及维数的数目 但是不能在将 一个数组定义为某种数据类型之后 再使用 ReDim 将该数组改为其它数据类型 除非是 Variant 所包含的数组 通过以下代码可以比较它们两者的区别 假设工作表中有图 13 4 所示数据 将区域的值赋与数组后再分别用两种方法重 置数组大小 看看它们的变化 Sub 重置数组 Dim arr arr2 声明一个数组 arr A1 E10 Value arr2 A1 E10 Value ReDim arr 1 To 2 1 To 3 重置数组大小为 2 行 3 列的二维数组 ReDim Preserve arr2 1 To 10 1 To 3 重置数组大小为 2 行 3 列的二维数组 MsgBox arr 2 3 星期二 星期三 星 期四 星期五 星期六 星期日 功能测试 在工作表中选择 A1 A7 区域 然后入以下公式 Week 产生 7 个中文星期序列 Week 2 产生 7 个英文星期序列 本例文件参见光盘 第十四章 自定义数组函数 xlsm Excel VBA 程序开发自学通 2020 4 5 第 444 页 共 513 页 14 1 4 获取区域的唯一值 案例要求 将引用区域去除重复值 将唯一值利用数组方式罗列出来 过程代码 Function only rng As Range Dim cell As Range onlys As New Collection Item As Long arr On Error Resume Next 如果引用区域不在已用区域中则函数返回空文本 If Intersect rng rng Parent UsedRange Is Nothing Then only Exit Function 将区域限制在已用区域中 防止用户选择整列或者全选工作表时造成死机 For Each cell In Intersect rng rng Parent UsedRange If cell Then onlys Add cell Value CStr cell Text Next 重置数组大小 其上界等于为重复数的个数 ReDim arr 1 To onlys Count For Item 1 To onlys Count 将不重复值逐个加入数组 arr arr Item onlys Item Next 将数组转置后赋与 only only WorksheetFunction Transpose arr End Function 注意事项 1 获取唯一值有很多方法 Countif 或者字典法 或者 Collection 对象法 经过 笔者的多次测试 利用 Collection 对象获取唯一值速度最快 它的一个特点是对象集 合中所有对象不能存在重值 那么将区域中所有元素加入到该对象集合中后再逐个 取出来 就可以过滤掉所有重复值 2 如果要对参数所代表的区域进行循环时 通常都需要限制为该区域与工作表已 用区域的交集 从而避免用户以整列 或者以 1 65536 做为参数时造成计算机进 行假死状态 而获取已用区域时需要的一个技巧是 用 rng Parent UsedRange 获 取目标工作表的已用区域 因为用户可能会引用其它工作表的区域做为参数的函数 功能测试 假设 A1 A10 有图 14 2 所示的数据 选择 B1 B10 可以获取该区域中唯一值 only A1 A10 因唯一值仅四个 那么在超过 4 个单元格以上的区域输入公式后 在第五个单 元格开始的区域会产生错误值 解决这个问题有两个办法 一是用 ROWS 函数判断 数组 only 的元素个数 将超出部分赋值为空 公式如下 IF ROW 1 10 ROWS only A1 A10 only A1 A10 公式结果见图 14 3 所示 第二个办法是按普通公式方式输入公式 以 Index 函数从数组中逐个取值 IFERROR INDEX only A 1 A 10 ROW Excel VBA 程序开发自学通 2020 4 5 第 445 页 共 513 页 图 14 2 获取 A1 A10 唯一值 图 14 3 消除错误值 本例文件参见光盘 第十四章 自定义数组函数 xlsm 14 2 数组应用案例 VBA 读写数组的速度远远快于读写单元格或者工作簿对象 所以操作单元格时 往往可以转换为对数组的操作 从而对程序提速 本节就查找方面的应用进行 6 个 案例演潮头 加深读者对数组的理解 14 2 1 将按姓名排列的纵向学员表转置为按班级横向排 列 案例要求 将图 14 4 中按姓名纵向排列的学员表转换换横向排列 以三个 班级为分类标准从 D 列开始罗列出来 过程代码 Sub 区域转置 Dim arr1 As Variant i As Long MaxRow As Long a b c Dim arr As Variant 记录最后一个非空行 MaxRow Cells Rows Count 1 End xlUp Row 将区域赋与数组 arr1 Range A2 B MaxRow 将三个班级赋与新数组 arr D1 D3 Value 重置数组大小 保留原来的值 三行 MaxRow 列 ReDim Preserve arr 1 To 3 1 To MaxRow For i 1 To MaxRow 1 将找到的数据 Select Case arr1 i 2 根据班级将姓名加入到数组相应的行中 Case arr 1 1 a a 1 arr 1 a 1 arr1 i 1 Case arr 2 1 Excel VBA 程序开发自学通 2020 4 5 第 446 页 共 513 页 b b 1 arr 2 b 1 arr1 i 1 Case arr 3 1 c c 1 arr 3 c 1 arr1 i 1 End Select Next i 将数组赋与区域 多行的学员表已转置为多列 Cells 1 4 Resize 3 MaxRow arr End Sub 注意事项 1 A B 列和 D1 D3 两个区域都有必要转化成数组 然后从数组中读写 从而提 升效率 2 MaxRow 的作用是让程序自动计算非空单元格最大行 当数据增减时可以体现 兼容性 3 ReDim Preserve 语句重置数组时可以保留其值 本例中不能使用 ReDim 功能测试 返回工作表 执行过程 区域转置 可以将 AB 列的学员表转置并存 Cells 1 4 Resize 3 MaxRow 区域 图 14 4 按姓名排列的学员表 本例文件参见光盘 第十四章 转置区域 xlsm 14 2 2 多表学员资料查询 案例要求 在多工作表中查询学员资料 包括成绩 姓名 地址 工作表 及学号 Excel VBA 程序开发自学通 2020 4 5 第 447 页 共 513 页 图 14 5 三个班级的成绩表 过程代码 Sub 成绩搜索 Dim Tim arr intRows As Long 姓名 As String firstAddress As String cell As Range 关闭屏幕更新 Application ScreenUpdating False 清除上次查询信息 Range A F Clear 设定查找目标 姓名 Application InputBox 您想查找谁的成绩 可以输入一个或者多字 查找目标 2 Tim Timer 初始化时间变量 遍历工作表 当前存放结果的工作表即除外 For i 1 To Sheets Count 1 在每个表 A 列中查找 Set cell Sheets i Range A A Find what 姓名 LookAt xlPart If Not cell Is Nothing Then firstAddress cell Address 0 0 Do intRows intRows 1 累加计数器 重定义数组大小 ReDim Preserve arr 1 To 6 1 To intRows arr 1 intRows Sheets i Name 数组第一子项目赋值为查找到的数 据所在工作表名 arr 2 intRows cell Address 0 0 数组第二子项目赋值为查找到的数据 的单元格地址 arr 3 intRows cell Value 数组第三子项目赋值为查 找到的姓名 arr 4 intRows cell Offset 0 1 Text 数组第四子项目赋值为查找 到的班级 arr 5 intRows cell Offset 0 2 Text 数组第五子项目赋值为查找 到的学号 arr 6 intRows cell Offset 0 3 Text 数组第六子项目赋值为查找 到的成绩 Set cell Sheets i Range A A FindNext cell Loop While Not cell Is Nothing And cell Address 0 0 firstAddress Excel VBA 程序开发自学通 2020 4 5 第 448 页 共 513 页 End If Next 如果找到有目标 If intRows 0 Then 将找到的值赋与单元格区域 然后添加边框与标题 Range A2 F intRows Application Transpose arr A1 F1 Array 工作表 地址 姓名 班级 学号 成绩 Range A1 F intRows Borders LineStyle xlContinuous End If Application ScreenUpdating True MsgBox Format Timer Tim 0 00 秒 提示总运行时间 End Sub 注意事项 1 因学员资料存在多工作表中 所以需要利用循环查找所有存放学员资料的工作 表 2 Find 的参数 LookAt xlPart 表示模糊查找 输入 张 可以找到所有姓 张 者的资料 3 查找数据时必须针对未查找数组时的状况进行处理 在本例中借用 intRows 0 来判断中是否有查找到目标 功能测试 返回工作工作表中后 执行过程 成绩搜索 将弹出一个对话框让用户输入待 查询对象的姓名 假设输入 张 那么查询结果见图 14 6 所示 图 14 6 多表资料查询 本例文件参见光盘 第十四章 学员资料查询 xlsm 14 2 3 自定义百家姓序列 案例要求 生成百家姓序列 使工作表中输入姓氏时可以填充式输入 过程代码 Sub 序列 生成百家姓序列 Application ScreenUpdating False On Error Resume Next Cells Columns Count 1 EntireColumn Clear 清除最后一列 Dim Item As Integer arr 1 To 477 将百家姓写入常量中 总共 477 个百家性 Excel VBA 程序开发自学通 2020 4 5 第 449 页 共 513 页 Const 单姓 As String 赵钱孙李周吴郑王冯陈褚卫蒋沈韩杨朱秦尤许何吕施张孔曹 严华金魏陶姜戚谢邹喻柏水窦章云苏潘葛奚范彭郎鲁韦昌马苗凤花方俞任袁柳酆鲍史唐费廉 岑薛雷贺倪汤滕殷罗毕郝邬安常乐于时傅皮卞齐康伍余元卜顾孟平黄和穆 萧尹姚邵湛汪祁毛禹狄米贝明臧计伏成戴谈宋茅庞熊纪舒屈项祝董梁杜阮蓝闵 席季麻强贾路娄危江童颜郭梅盛林刁钟徐邱骆高夏蔡田樊胡凌霍虞万支柯昝管卢莫柯房裘缪 干解应宗丁宣贲邓郁单杭洪包诸左石崔吉钮龚程嵇邢滑裴陆荣 翁荀羊于惠甄曲家封芮羿储靳汲邴糜松井段富巫乌焦巴弓牧隗山谷车侯宓蓬全 郗班仰秋仲伊宫宁仇栾暴甘钭历戎祖武符刘景詹束龙叶幸司韶郜黎蓟溥印宿白怀蒲邰从鄂索 咸籍赖卓蔺屠蒙池乔阳郁胥能苍双闻莘党翟谭贡劳逄姬申扶堵 冉宰郦雍却璩桑桂濮牛寿通边扈燕冀浦尚农温别庄晏柴瞿阎充慕连茹习宦艾鱼 容向古易慎戈廖庾终暨居衡步都耿满弘匡国文寇广禄阙东欧殳沃利蔚越夔隆师巩厍聂晁勾敖 融冷訾辛阚那简饶空曾毋沙乜养鞠须丰巢关蒯相查后荆红游竺 权逮盍益桓公 Const 复姓 As String 万俟司马上官欧阳夏侯诸葛闻人东方赫连皇甫尉迟公羊澹台 公冶宗政濮阳淳于单于太叔申屠公孙仲孙轩辕令狐徐离宇文长孙慕容司徒司空亓官司寇仉督 子车颛孙端木巫马公西漆雕乐正壤驷公良拓拔夹谷宰父谷梁晋楚闫法汝鄢涂钦 段干百里东郭南门呼延归海羊舌微生岳帅缑亢况后有琴梁丘左丘东门西门商牟 佘佴伯赏南宫 For i 1 To 407 遍历 407 个单字百家姓 arr i Mid 单姓 i 1 将百家姓加入数组中 Next For i 1 To 140 Step 2 遍历 120 个复姓 arr 407 i 1 2 Mid 复姓 i 2 将复姓追加入数组中 Next i 将数组导入自定义序列 Application AddCustomList WorksheetFunction Transpose arr End Sub 注意事项 1 百家姓可以去百度等搜索引擎查找 然后将它转换成字符串做代码调用 2 因每行代码有长度限制 所以对常量赋值时必须将它截断成多行 3 单姓与复姓的截取时标准不同 所以需要两个变量 MID 的第三参数也不同 4 将百宝姓逐个写入单元格中 然后将区域一次性导入序列也是可行的 然而相 对于数组在效率上略差 功能测试 光标位于过程中任意位置 并按下快捷键 F5 执行过程 然后返回工作表中 在 A1 输入赵 当 A1 向下填充时 可以产生百家姓序列 总共 477 个 见图 14 7 所示 Excel VBA 程序开发自学通 2020 4 5 第 450 页 共 513 页 图 14 7 填充百家姓 本例文件参见光盘 第十四章 生成百家姓序列 xlsm 14 2 4 查询两列共有项 案例要求 将 AB 列中相同的数据提取出来 过程代码 Sub 共有项 声明变量 包括三个数组变量 其中从区域转换成数组的变量虽然只有单列 但却不能通 过一维纵向数组的方式访问 Dim arr1 As Variant arr2 As Variant arr3 As Variant Item1 As Integer Item2 As Integer SameCount Counter As Byte 将区域转换成数组 arr1 Range A2 Cells Rows Count 1 End xlUp Value arr2 Range B2 Cells Rows Count 2 End xlUp Value 计算两列中相同数的个数 减少 ReDim 的次数 如果不计算相数同 那么可以在循环 中多次使用 ReDim Preserve 来解决 SameCount Application Evaluate sumproduct countif Range A2 Cells Rows Count 1 End xlUp Address Range B2 Cells Rows Count 2 End xlUp Address ReDim arr3 1 To SameCount 嵌套循环 比较 A 列的与 B 列有哪些相同 将相同的值加入数组 Arr2 For Item1 1 To UBound arr1 For Item2 1 To UBound arr2 如果相同加入第三个数组 注意第两个数组与第三个数组的参数个数不同 If arr1 Item1 1 arr2 Item2 1 Then Counter Counter 1 arr3 Counter arr1 Item1 1 Next Item2 Next Item1 MsgBox 两列中相同项为 Chr 10 Join arr3 End Sub 注意事项 1 本例中声明了三个数组 Arr1 和 Arr2 通过一列的区域转换成数组 那么在访 问其元素时不能当成一维纵向数组处理 必须使用两个参数 例如 Arr1 1 1 而且 其默认下界是 1 不是 0 2 为了减少数组变量的重置次数 本例中使用了 Evaluate 方法计算两列是相同 值的个数 做为数组的上界 当数组上界很大时 此方法会具有速度上的优势 功能测试 光标位于过程中任意位置 并按下快捷键 F5 执行过程 两列同相同项为图 14 9 所示 Excel VBA 程序开发自学通 2020 4 5 第 451 页 共 513 页 图 14 8 参赛人员列表 图 14 9 相同项列表 本例文件参见光盘 第十四章 获取相同项目 xlsm 14 2 5 获取文件夹下所有文件详细信息 案例要求 将指定文件夹中所有文件的文件名 创建时间 上次访问时间 上次修改时间 文件大小 文件类 路径等信息罗列在工作表中 过程代码 Sub 批量获取文件信息 遍历指定路径两级文件夹内文件信息 如果需要更多级可根据 需要修改 Dim fd As FileDialog Fso Fold File Folds Filess arr Item As Long 让用户选择路径 Set fd Application FileDialog msoFileDialogFolderPicker 如果选择了文件夹则记录路径 If fd Show 1 Then PathStr fd SelectedItems 1 Else Exit Sub End If 设置标题