完全手册Excel VBA典型实例大全:通过368个例子掌握

目录VBA学习第1章  宏的应用技巧宏是一个VBA程序,通过宏可以完成枯燥的、频繁的重复性工作。本章的实例分别介绍在Excel 2003、Excel 2007中录制宏、使用Visual Basic代码创建宏的方法,最后还以实例演示运行宏和编辑宏的方法。1.1  创建宏   1例001  在Excel 2003中录制宏 1例002  打开Excel 2007的录制宏功能     3例003  在Excel 2007中录制宏 4例004  使用Visual Basic创建宏       51.2  管理宏   6例005  运行宏     7例006  编辑宏     8第2章  VBE使用技巧VBE(Visual Basic Editor)是编写VBA代码的工具,在上一章中曾使用VBE编辑宏代码。本章的实例介绍了设置VBE操作环境、在VBE中管理工程代码、使用VBE的辅助工具提高代码输入效率等方法。2.1  设置VBE操作环境     10例007  停靠VBE子窗口    10例008  定制VBE环境       122.2  工程管理      13例009  增加模块 13例010  删除模块 15例011  导出模块 16例012  导入模块 172.3  管理代码      18例013  属性/方法列表       18例014  常数列表 19例015  参数信息 20例016  自动完成关键字     21第3章  程序控制流程技巧结构化程序设计中使用的基本控制结构有3种:顺序结构、选择结构和循环结构。本章以实例演示了VBA中这三种控制结构的控制语句,最后还介绍了在VBA中使用数组的方法。3.1  常用输入/输出语句     23例017  九九乘法表(Print方法的应用) 23例018  输入个人信息(Inputbox函数的应用)     24例019  退出确认(Msgbox函数的应用)      253.2  分支结构      27例020  突出显示不及格学生     27例021  从身份证号码中提取性别     29例022  评定成绩等级 30例023  计算个人所得税     323.3  循环结构      34例024  密码验证 34例025  求最小公倍数和最大公约数 36例026  输出ASCII码表     37例027  计算选中区域数值之和 39例028  换零钱法(多重循环) 403.4  使用数组      42例029  数据排序 42例030  彩票幸运号码 44例031  用数组填充单元格区域 46第4章  Range对象操作技巧用户在使用Excel时,大部分时间都是在操作单元格中的数据,同样地,在Excel中使用VBA编程时,也需要频繁地引用单元格区域。本章实例介绍用VBA引用单元格、获取单元格信息、操作单元格数据、设置单元格格式等内容。4.1  获取单元格的引用      48例032  使用A1样式引用单元格      48例033  使用索引号引用单元格 49例034  引用多个单元格区域     50例035  合并单元格区域     51例036  引用合并区域的子区域 52例037  动态选中单元格区域     53例038  引用相对其他单元格的单元格     54例039  扩展单元格区域     55例040  引用单元格交叉区域     56例041  引用当前区域 57例042  获取已使用区域     58例043  引用区域内的单元格     59例044  设置标题行格式     61例045  选取条件格式单元格     62例046  选择数据列末单元格     63例047  获取某列连续数据区域 64例048  获取多个不同长度的非连续列     65例049  当前单元格的前后单元格     65例050  获取三维区域 664.2  获取单元格信息   67例051  获取标题行和数据行     67例052  获取当前区域信息 68例053  单元格区域是否有公式 69例054  追踪公式单元格     70例055  获取单元格地址     714.3  操作单元格   72例056  合并相同值单元格 72例057  删除指定字符后的内容 73例058  给单元格设置错误值     75例059  活动单元格错误类型     76例060  自动设置打印区域 77例061  按设置长度换行     77例062  选择不含公式的单元格 79例063  生成不重复随机数 80例064  拆分单元格     82例065  添加超链接     83例066  删除超链接     84例067  限制单元格移动范围     85例068  插入批注 86例069  隐藏/显示批注       87例070  删除批注 87例071  复制单元格区域     88例072  给单元格设置公式 90例073  复制公式 90例074  查找并填充空白单元格 91例075  清除单元格     92例076  删除单元格区域     934.4  设置单元格格式   94例077  按颜色统计单元格数量 94例078  获取单元格底纹和图案 95例079  设置页眉为单元格值     96例080  设置日期格式 97例081  生成大写金额 98例082  格式化当前区域的数据 100例083  设置自动套用格式 101例084  突出显示当前位置 101例085  设置边框线     103例086  设置文本对齐格式 104例087  单元格文本缩排     105例088  设置文本方向 107例089  设置自动换行格式 108例090  设置缩小字体填充 108例091  设置条件格式 109例092  设置单元格图案     111例093  合并单元格     112第5章  Worksheet对象操作技巧Worksheet对象表示Excel工作簿中的工作表,Worksheet对象是Worksheets集合的成员。在VBA中,通过操作Worksheet对象和Worksheets集合对象,即可控制Excel的工作表。本章实例介绍了用VBA代码操作工作表、操作工作表行和列、通过工作表事件控制工作表等内容。5.1  控制工作表集合   114例094  增加工作表     114例095  窗体方式新增工作表     115例096  窗体方式删除工作表     118例097  批量新建工作表     119例098  获取工作表数 120例099  循环激活工作表     121例100  选择工作表     121例101  选取前一个工作表/后一个工作表       122例102  选中工作表的名称 123例103  保护工作表     124例104  撤销工作表的保护 126例105  判断工作表是否存在     127例106  工作表排序     129例107  复制工作表     130例108  移动工作表     131例109  删除工作表     132例110  删除空工作表 133例111  密码控制删除工作表     134例112  隐藏/显示工作表    135例113  工作表移至最前/最后    136例114  工作表打印页数     137例115  重命名工作表 138例116  设置工作表标签颜色     140例117  导出工作表     1415.2  操作工作表的行和列   144例118  删除空行 144例119  插入行     145例120  插入多行 146例121  插入列     147例122  隐藏/显示行    148例123  隐藏/显示列    149例124  设置行高 149例125  设置列宽 1515.3  操作工作表   152例126  合并工作表数据     152例127  工作表是否被保护 153例128  制作工作表目录     154例129  删除图片 155例130  修改工作表的代码名     1565.4  控制工作表事件   158例131  为输入数据的单元格添加批注     158例132  自动填充相同值     159例133  记录同一单元格多次输入值 160例134  禁止选中某个区域 161例135  禁止输入相同数据 162例136  设置滚动区域 163例137  自动添加边框线     164例138  限制在数据区域下一行输入数据 165例139  增加快捷菜单 166例140  限制选择其他工作表     168例141  自动隐藏工作表     169例142  将原数据作批注     170例143  输入编码 171第6章  Workbook对象操作技巧Workbook对象表示Excel工作簿,Workbooks集合对象表示Excel中所有打开的工作簿。本章实例介绍VBA控制工作簿的方法,包括对工作簿集合和工作簿的操作、通过工作簿事件控制工作簿的操作。6.1  操作工作簿集合   173例144  批量新建工作簿     173例145  设置背景音乐 174例146  打开工作簿     176例147  保存工作簿     177例148  更名保存工作簿     178例149  将工作簿保存为Web页       180例150  打开文本文件 181例151  设置工作簿密码     182例152  保护工作簿     184例153  查看文档属性 185例154  处理命名单元格区域     187例155  判断工作簿是否存在     190例156  判断工作簿是否打开     191例157  备份工作簿     192例158  获取关闭工作簿中的值(方法1)      194例159  获取关闭工作簿中的值(方法2)      196例160  多工作簿数据合并 1976.2  控制工作簿事件   199例161  自动打开关联工作簿     199例162  禁止拖动单元格     200例163  设置新增工作表为固定名称 201例164  退出前强制保存工作簿 202例165  限制打印 203例166  限制保存工作簿     204例167  限制工作簿使用次数     205例168  限制工作簿使用时间     207例169  设置应用程序标题 207例170  根据密码打开工作簿     209例171  打开工作簿禁用宏 210例172  用VBA删除宏代码       212第7章  Application对象操作技巧Application对象代表整个Excel应用程序,使用Application对象可控制应用程序范围的设置和选项。本章实例介绍使用VBA,通过Application对象自定义Excel外观、设置Excel操作选项、控制Excel应用程序,以及通过Application对象的OnTime方法和OnKey方法响应用户操作的内容。7.1  自定义Excel外观       214例173  显示/关闭编辑栏    214例174  设置状态栏     215例175  控制鼠标指针形状 217例176  全屏幕显示     218例177  最大化Excel窗口  219例178  查询计算机信息     2197.2  设置Excel操作选项    220例179  关闭屏幕刷新 220例180  禁止弹出警告信息 222例181  复制/剪切模式       223例182  获取系统路径 2247.3  控制应用程序      225例183  激活Microsoft应用程序       225例184  控制最近使用文档 226例185  文件选择器     228例186  快速跳转 230例187  激活Excel 2007的功能区选项卡 2327.4  Application对象事件处理    234例188  工作表上显示时钟 234例189  整点报时 235例190  自定义功能键 236第8章  Window对象操作技巧Window对象代表一个窗口,许多工作表特征(如滚动条和标尺)实际上是窗口的属性。本章实例介绍用VBA控制窗口的方法,包括通过Window对象的属性和方法创建、拆分窗口、设置窗口大小、显示比例、控制窗口显示状态等。8.1  控制窗口      238例191  创建窗口 238例192  调整窗口大小 239例193  获取窗口状态 242例194  拆分窗格 243例195  并排比较窗口 244例196  排列窗口 245例197  窗口显示比例 2468.2  控制工作表的显示选项      248例198  工作簿显示选项     248例199  工作表显示选项     249例200  工作表网格线 250例201  获取指定窗口选中的信息     252第9章  Chart对象操作技巧在Excel中可以快速简便地创建图表。在程序中,通过VBA代码也可方便地创建图表。本章实例介绍用VBA创建图表(包括嵌入式图表)、控制图表中的对象、通过图表事件响应用户操作等内容。9.1  创建图表      254例202  创建图表工作表     254例203  创建嵌入图表 255例204  转换图表类型 257例205  删除图表 2589.2  控制图表对象      260例206  获取嵌入图表的名称     260例207  获取图表标题信息 260例208  获取图例信息 262例209  获取图表坐标轴信息     263例210  获取图表的系列信息     264例211  判断工作表的类型 265例212  重排嵌入图表 266例213  调整图表的数据源 268例214  为图表添加阴影     269例215  显示数据标签 271例216  将图表保存为图片 273例217  设置图表颜色 274例218  按值显示颜色 276例219  修改嵌入图表外形尺寸 277例220  修改图表标题 279例221  修改坐标轴     280例222  图表插入到Word文档  2829.3  图表事件      283例223  激活图表工作表     283例224  显示图表各子对象名称 284例225  捕获嵌入图表事件 285第10章  用户界面设计技巧在Excel中,用户大部分时间是在工作表中进行操作。在Excel中,也可以设计用户窗体,用户直接在窗体上进行操作,而将工作表作为保存数据的地方。本章实例介绍在VBA中调用Excel内置对话框、在VBE中创建自定义窗体等内容。10.1  使用内置对话框 288例226  显示打开对话框(使用GetOpenFilename方法)      288例227  显示保存文件对话框(使用GetSaveAsFilename方法)   290例228  显示内置对话框     291例229  用VBA调用Excel 2007功能区功能    29310.2  创建自定义窗体 294例230  制作Splash窗口    294例231  控制窗体显示 295例232  列表框间移动数据 297例233  通过窗体向工作表添加数据 302例234  制作多页窗体——报名登记 305例235  通过窗体设置单元格格式     307例236  用窗体控制工作表显示比例 308例237  调色板窗体     311例238  在窗体中显示图表 312例239  制作向导窗体 314例240  拖动窗体上的控件 317例241  制作交通信号灯     318例242  制作进度条     320第11章  命令栏和功能区操作技巧在Excel 2007中,以新的功能区取代了以前版本的命令栏(包括菜单栏和工具栏)。本章实例分别介绍了用VBA控制Excel 2003以前版本的命令栏、用XML自定义Excel 2007功能区等内容。11.1  控制命令栏 322例243  显示内置菜单和工具栏的ID       322例244  创建自定义菜单     323例245  删除自定义菜单     325例246  创建快捷菜单 326例247  禁止工作表标签快捷菜单     328例248  屏蔽工作表标签部分快捷菜单     32911.2  Excel 2007的功能区  330例249  创建功能区选项卡 330例250  禁用Office按钮的菜单 332例251  在“Office按钮”中新建菜单     333例252  重定义“Office按钮”菜单项功能     335例253  为内置选项卡增加功能 336第12章  Excel处理工作表数据技巧通过Excel相关对象可对工作表中的数据进行操作,如处理单元格区域的公式、对数据进行查询、排序、筛选等操作。本章实例介绍了用VBA处理公式,对数据进行查询、排序、筛选等内容。12.1  处理公式    339例254  判断单元格是否包含公式     339例255  自动填充公式 340例256  锁定和隐藏公式     341例257  将单元格公式转换为数值     342例258  删除所有公式 343例259  用VBA表示数组公式    34512.2  数据查询    346例260  查找指定的值 346例261  带格式查找     349例262  查找上一个/下一个数据       349例263  代码转换 351例264  模糊查询 353例265  网上查询快件信息 354例266  查询基金信息 357例267  查询手机所在地     358例268  使用字典查询36012.3  数据排序    361例269  用VBA代码排序    362例270  乱序排序 363例271  自定义序列排序     364例272  多关键字排序 366例273  输入数据自动排序 367例274  数组排序 369例275  使用Small和Large函数排序       370例276  使用RANK函数排序    372例277  姓名按笔画排序     37412.4  数据筛选    376例278  用VBA进行简单筛选    377例279  用VBA进行高级筛选    378例280  筛选非重复值 380例281  取消筛选 381第13章  Excel处理数据库技巧通过VBA代码,可在Excel中访问数据库。本章实例介绍通过ADO访问Excel工作簿中的数据、在Excel中处理Access数据库(包括获取、添加、修改、删除记录,创建Access数据)等内容。13.1  用ADO访问Excel工作表       383例282  使用ADO连接数据库   383例283  从工作表中查询数据     384例284  使用ADO导出数据      386例285  汇总数据 387例286  不打开工作簿获取工作表名称     38813.2  处理Access数据库   390例287  从Access中获取数据   390例288  添加数据到Access 391例289  创建Access数据库       393例290  是否存在指定表     395例291  列出数据库的表名 396例292  列出数据表的字段信息 398例293  修改记录 399例294  删除记录 401第14章  创建加载宏技巧在Excel中,通过加载宏可以扩展功能,加载宏是为Excel提供自定义命令或自定义功能的补充程序。本章实例介绍了在Excel中通过VBA代码创建Excel加载宏和COM加载宏的方法。14.1  创建加载宏的方法    404例295  创建Excel加载宏  404例296  创建COM加载宏  408例297  系统加载宏列表     41314.2  常用加载宏示例 414例298  时间提示 414例299  大写金额转换 416例300  计算个人所得税     418例301  加盖公章 419第15章  文件和文件夹操作技巧通过VBA代码可在Excel中操作文件。有两种方式访问操作文件和文件夹:一是使用过程形式的VB访问和操作方法,另一种是将文件系统作为对象的文件对象模型方式。本章实例介绍了用VB语句操作文件和文件夹、用FSO操作文件和文件夹的内容。15.1  用VB语句操作文件和文件夹  422例302  显示指定文件夹的文件 422例303  判断文件(文件夹)是否存在     424例304  新建文件夹     425例305  复制文件 426例306  重命名文件或文件夹     427例307  删除文件 429例308  查看文件属性 43015.2  用FSO操作文件和文件夹       432例309  判断文件是否存在(FSO)  432例310  分离文件名和扩展名     434例311  新建和删除文件夹(FSO)  435例312  复制文件(FSO)  437例313  复制文件夹(FSO)     439例314  列出文件夹名称     440例315  显示文件属性 441例316  删除所有空文件夹 442例317  显示驱动器信息     444第16章  文本文件操作技巧上一章介绍了对文件进行复制、删除之类的操作,更多的时候用户还需要从文本文件中读取数据,或向文本文件中写入数据。本章实例介绍用VBA操作文本文件的内容,包括用VB语句操作文本文件和用FSO操作文本文件。16.1  用VB语句操作文本文件  446例318  创建文本文件 446例319  读取文本文件数据 448例320  工作表保存为文本文件 450例321  导出批注到文本文件     451例322  从文本文件导入批注     45316.2  用FSO操作文本文件       455例323  创建文本文件(FSO)  455例324  添加数据到文本文件(FSO)     456例325  读取文本文件数据(FSO)  458第17章  用Excel控制其他程序技巧在Excel中,通过VBA代码可调用其他应用程序的功能。包括创建和打开Word文档、创建和打开幻灯片、发送和导入Outlook邮件等。另外,使用VBA提供的Shell函数还可打开Windows中的其他程序、打开控制面板对应的选项等。17.1  控制Office应用程序 460例326  打开Word文档      460例327  从Word文档中获取数据      462例328  生成成绩通知书     464例329  在Excel中打开PPT      469例330  在Excel中创建PPT      470例331  使用SendMail发送邮件 473例332  用Outlook发送邮件      474例333  导入Outlook中的邮件  476例334  保存Outlook中的附件  47817.2  调用其他程序    479例335  运行系统自带程序 479例336  在Excel中打开控制面板      481第18章  VBE工程实用操作技巧在第2章中介绍了VBE的使用方法。其实,VBE也包含一个对象模型,通过该对象模型可控制VBA工程的主要元素。本章实例介绍通过VBE对象模型,用VBA代码添加或删除模块、创建用户窗体、生成VBA代码等内容。18.1  显示工程相关信息    483例337  显示工程信息 483例338  列出工程所有组件 485例339  显示工作簿中VBA的过程名       486例340  导出VBA过程代码       488例341  列出工程引用的外部库 48918.2  动态创建组件    490例342  重命名组件     490例343  导出/导入模块代码       492例344  删除指定子过程代码     494例345  查找代码 496例346  增加模块 498例347  增加类模块     500例348  控制VBE的子窗口       501例349  工作表中动态增加按钮 502例350  创建动态用户窗体 504第19章  VBA程序调试优化技巧Excel应用程序的顺利完成,调试的过程是非常重要的。本章实例介绍Excel VBA调试程序的基本方法和VBA程序的优化技巧。19.1  VBA程序调试技巧    507例351  设置断点 507例352  使用本地窗口 508例353  使用立即窗口 510例354  单步执行 510例355  运行选定部分代码 512例356  调用堆栈 513例357  使用监视窗口 514例358  使用条件编译 515例359  错误处理语句 51719.2  VBA程序优化技巧    518例360  使用VBA已有功能       518例361  避免使用变体 520例362  使用对象变量 521例363  使用数组处理单元格     522例364  检查字符串是否为空     522例365  优化循环体     523例366  使用For Each循环 525例367  关闭屏幕刷新 526例368  使用内置函数 527VBA应用程序由一系列的VBA代码组成,这些代码将按照一定的顺序执行。有时程序根据一定的条件只能执行某一部分代码,有时需要重复执行某一段代码。通过程序结构控制代码来完成这些功能,本章介绍这些程序控制流程方面的技巧。3.1  常用输入/输出语句结构化程序设计中使用的基本控制结构有3种:顺序结构、选择结构和循环结构。顺序结构就是按照语句的书写顺序从上到下、逐条语句地执行。执行时,编写在前面的代码先执行,编写在后面的代码后执行。这是最普遍的结构形式,也是后面两种结构的基础。顺序结构不需要使用结构控制语句,本节介绍常用的输入输出语句的技巧。例017  九九乘法表(Print方法的应用)1.案例说明在早期的Basic版本中,程序运行结果主要依靠Print语句输出到终端。在VB中,Print作为窗体的一个方法,用来在窗体中显示信息。但是在VBA中,用户窗体已经不支持Print方法了。在VBA中,Print方法只能向“立即窗口”中输出程序的运行中间结果,供开发人员调试程序时使用。本例使用Print方法在立即窗口中输入九九乘法表。2.关键技术在VBA中,Print方法只能应用于Debug对象,其语法格式如下:Debug.Print [outputlist]参数outputlist是要打印的表达式或表达式的列表。如果省略,则打印一个空白行。—    Print首先计算表达式的值,然后输出计算的结果。在outputlist参数中还可以使用分隔符,以格式化输出的数据。格式化分隔符有以下几种:—    Spc(n):插入n个空格到输出数据之间;—    Tab(n):移动光标到适当位置,n为移动的列数;—    分号:表示前后两个数据项连在一起输出;—    逗号:以14个字符为一个输出区,每个数据输出到对应的输出区。3.编写代码(1)在VBE中,单击菜单“插入/模块”命令插入一个模块。(2)在模块中输入以下代码:Sub multi()For i = 1 To 9For j = 1 To iDebug.Print i; "x"; j; "="; i * j; "  ";NextDebug.Print                                       '换行NextEnd Sub(3)按功能键“F5”运行子过程,在“立即窗口”输出九九乘法表,如图3-1所示。

图3-1  立即窗口例018  输入个人信息(Inputbox函数的应用)1.案例说明本例演示Inputbox函数的使用方法。执行程序,将弹出“输入个人信息”对话框,要求用户输入“姓名、年龄、地址”信息,然后在“立即窗口”中将这些信息打印输出。2.关键技术为了实现数据输入,VBA提供了InputBox函数。该函数将打开一个对话框作为输入数据的界面,等待用户输入数据,并返回所输入的内容。其语法格式如下:InputBox(prompt[, title] [, default] [, xpos] [, ypos] [, helpfile, context])各参数的含义如下:—    Prompt:为对话框消息出现的字符串表达式。其最大长度为1024个字符。如果需要在对话框中显示多行数据,则可在各行之间用回车符换行符来分隔,一般使用VBA的常数vbCrLf代表回车换行符。—    Title:为对话框标题栏中的字符串。如果省略该参数,则把应用程序名放入标题栏中。—    Default:为显示在文本框中的字符串。如果省略该参数,则文本框为空。—    Xpos:应和Ypos成对出现,指定对话框的左边与屏幕左边的水平距离。如果省略该参数,则对话框会在水平方向居中。—    Ypos:应和Xpos成对出现,指定对话框的上边与屏幕上边的距离。如果省略该参数,则对话框被放置在屏幕垂直方向距下边大约三分之一的位置。—    Helpfile:设置对话框的帮助文件,可省略。—    Context:设置对话框的帮助主题编号,可省略。3.编写代码(1)在VBE中,单击菜单“插入/模块”命令插入一个模块。(2)在模块中输入以下代码:Sub inputinfo()Title = "输入个人信息"name1 = "请输入姓名:"age1 = "请输入年龄:"address1 = "请输入地址:"strName = InputBox(name1, Title)age = InputBox(age1, Title)Address = InputBox(addres1, Title)Debug.Print "姓名:"; strNameDebug.Print "年龄:"; ageDebug.Print "地址:"; AddressEnd Sub(3)按功能键“F5”运行子过程,将弹出“输入个人信息”窗口,如图3-2所示。在对话框中输入内容后按“回车”,或单击“确定”按钮。(4)接着输入“年龄”和“地址”信息,在“立即窗口”中将输出这些内容,如图3-3所示。

图3-2  输入个人信息                          图3-3  输出结果例019  退出确认(Msgbox函数的应用)1.案例说明在应用程序中,有时用户会由于误操作关闭Excel,为了防止这种情况,可在退出Excel之前弹出对话框,让用户确认是否真的要关闭Excel。本例使用Msgbox函数弹出对话框,让用户选择是否退出系统。2.关键技术使用MsgBox函数可打开一个对话框,在对话框中显示一个提示信息,并让用户单击对话框中的按钮,使程序继续执行。MsgBox函数语法格式如下:Value=MsgBox(prompt[,buttons][,title][ ,helpfile,context])通过函数返回值可获得用户单击的按钮,并可根据按钮的不同而选择不同的程序段来执行。该函数共有5个参数,除第1个参数外,其余参数都可省略。各参数的意义与Inputbox函数参数的意义基本相同,不同的地方是多了一个buttons参数,用来指定显示按钮的数目及形式、使用提示图标样式、默认按钮以及消息框的强制响应等。其常数值如表3-1所示。表3-1  按钮常数值常    量值说    明vbOkOnly0只显示“确定”(Ok)按钮vbOkCancel1显示“确定”(Ok)及“取消”(Cancel)按钮vbAbortRetryIgnore2显示“异常终止”(Abort)、“重试”(Retry)及“忽略”(Ignore)按钮vbYesNoCancel3显示“是”(Yes)、“否”(No)及“取消”(Cancel)按钮续表常    量值说    明vbYesNo4显示“是”(Yes)及“否”(No)按钮vbRetryCancel5显示“重试”(Retry)及“取消”(Cancel)按钮vbCritical16显示Critical Message图标

vbQuestion32显示Warning Query图标

vbExclamation48显示Warning Message图标

vbInformation64显示Information Message图标

vbDefaultButton10以第一个按钮为默认按钮vbDefaultButton2256以第二个按钮为默认按钮vbDefaultButton3512以第三个按钮为默认按钮vbDefaultButton4768以第四个按钮为默认按钮vbApplicationModal0进入该消息框,当前应用程序暂停vbSystemModal4096进入该消息框,所有应用程序暂停表3-1中的数值(或常数)可分为四组,其作用分别为:—    第一组值(0~5)用来决定对话框中按钮的类型与数量。—    第二组值(16,32,48,64)用来决定对话框中显示的图标。—    第三组值(0,256,512)设置对话框的默认活动按钮。活动按钮中文字的周转有虚线,按回车键可执行该按钮的单击事件代码。—    第四组值(0,4096)决定消息框的强制响应性。

buttons参数可由上面4组数值组成,其组成原则是:从每一类中选择一个值,把这几个值累加在一起就是buttons参数的值(大部分时间里都只使用前三组数值的组合),不同的组合可得到不同的结果。3.编写代码(1)在VBE中,双击“工程”子窗口中的“ThisWorkbook”打开代码窗口,如图3-4所示。(2)在代码窗口左上方的对象列表中选择“Workbook”,如图3-5所示。(3)在代码窗口右上方的事件列表中选择“BeforeClose”,如图3-6所示。代码窗口中将自动生成事件过程结构如下:

图3-5  对象列表                               图3-6  事件列表Private Sub Workbook_BeforeClose(Cancel As Boolean)End Sub(4)在上面生成的事件过程中输入以下代码:Private Sub Workbook_BeforeClose(Cancel As Boolean)Dim intReturn As IntegerintReturn = MsgBox("真的退出系统吗?", vbYesNo + vbQuestion, "提示")If intReturn <> vbYes Then Cancel = TrueEnd Sub

(5)保存Excel工作簿。(6)关闭Excel工作簿时,将弹出如图3-7所示的对话框。单击“是”按钮将退出Excel,单击“否”按钮将返回Excel工作簿。3.2  分支结构分支结构,又叫选择结构。这种结构的程序将根据给定的条件来决定执行哪一部分代码,而跳过其他代码。例020  突出显示不及格学生1.案例说明本例判断学生成绩表中的成绩,如果成绩不及格(低于60分),则将该成绩着重显示出来。如图3-8所示(左图为原成绩,右图突出显示不及格成绩)。

图3-8  突出显示不及格学生2.关键技术在本例中,需要进行一个判断(成绩是否低于60分),这时可使用If…Then语句。用If…Then语句可有条件地执行一个或多个语句。其语法格式如下:If 逻辑表达式 Then语句1语句1… …语句nEnd If

逻辑表达式也可以是任何计算数值的表达式,VBA将为零(0)的数值看做False,而任何非零数值都被看做True。该语句的功能为:若逻辑表达式的值是True,则执行位于Then与End If之间的语句;若逻辑表达式的值是False,则不执行Then与End If之间的语句,而执行End If后面的语句。其流程图如图3-9所示。If…Then结构还有一种更简单的形式:单行结构条件语句。其语法格式如下:If 逻辑表达式 Then 语句该语句的功能为:若逻辑表达式的值是True,则执行Then后的语句;若逻辑表达式的值是False,则不执行Then后的语句,而执行下一条语句。3.编写代码(1)打开“学生成绩表”。(2)按快捷键“Alt+F11”进入VBE环境。(3)单击菜单“插入/模块”命令向工程中插入一个模块,并编写以下代码:Sub 显示不及格学生()Dim i As IntegerFor i = 3 To 11If Sheets(1).Cells(i, 2).Value < 60 ThenSheets(1).Cells(i, 2).SelectSelection.Font.FontStyle = "加粗"Selection.Font.ColorIndex = 3End IfNextEnd Sub(4)关闭VBE开发环境返回Excel。(5)在功能区“开发工具”选项卡的“控件”组中,单击“插入”按钮弹出“表单控件”面板,如图3-10所示。

图3-10  插入按钮(6)在“表单控件”面板中单击“按钮”,拖动鼠标在工作表中绘制一个按钮。当松开鼠标时,将弹出“指定宏”对话框,如图3-11所示。(7)在“指定宏”对话框中,单击选中“显示不及格学生”宏,单击“确定”按钮。(8)右击工作表中的按钮,弹出快捷菜单如图3-12所示,单击“编辑文字”菜单,修改按钮中的提示文字为“显示不及格学生”。

图3-11  指定宏                              图3-12  编辑文字(9)单击“显示不及格学生”按钮,执行宏代码,成绩表中不及格成绩将突出显示为粗体、红色,如图3-13所示。

图3-13  执行程序例021  从身份证号码中提取性别1.案例说明在很多信息系统中都需要使用到身份证号码,身份证号码中包含有很多信息,如可从其中提取性别。我国现行使用的身份证号码有两种编码规则,即15位居民身份证和18位居民身份证。15位的身份证号的编码规则。dddddd yymmdd xx p18位的身份证号的编码规则。dddddd yyyymmdd xx p y其中:—    dddddd为地址码(省地县三级)18位中的和15位中的不完全相同。—    yyyymmdd yymmdd 为出生年月日。—    xx序号类编码。—    p性别。—    18位中末尾的y为校验码。2.关键技术在If…Then语句中,条件不成立时不执行任何语句。在很多时候需要根据条件是否成立分别执行两段不同的代码,这时可用If…Then…Else语句,其语法格式如下:If 逻辑表达式 Then语句序列1Else语句序列2End If

VBA判断“逻辑表达式”的值,如果它为True,将执行“语句序列1”中的各条语句,当“逻辑表达式”的值为False时,就执行“语句序列2”中的各条语句。其流程图如图3-14所示。3.编写代码(1)新建Excel工作簿,在VBE中插入一个模块。(2)在模块中编写以下代码:Sub 根据身份证号码确定性别()sid = InputBox("请输入身份证号码:")i = Len(sid)If i <> 15 And i <> 18 Then              '判断身份证号长度是否正确MsgBox "身份证号码只能为15位或18位!"Exit SubEnd IfIf i = 15 Then                           '长度为15位s = Right(sid, 1)                     '取最右侧的数字Else                                     '长度为18度s = Mid(sid, 17, 1)                   '取倒数第2位数End IfIf Int(s / 2) = s / 2 Then               '为偶数sex = "女"Elsesex = "男"End IfMsgBox "性别:" + sexEnd Sub(3)切换到Excel环境,添加一个按钮“从身份证号码提取性别”,并指定执行上步创建的宏。(4)单击“从身份证号码提取性别”按钮,弹出如图3-15所示对话框。(5)输入身份证号码后单击“确定”按钮,将在如图3-16所示对话框中显示性别。

图3-15  输入身份证号码                          图3-16  显示性别例022  评定成绩等级1.案例说明本例将成绩表中的百分制成绩按一定规则划分为A、B、C、D、E五个等级,如图3-17所示。

图3-17  评定成绩等级其中各等级对应的成绩分别为:—    A:大于等于90分;—    B:大于等于80分,小于90分;—    C:大于等于70分,小于80分;—    D:大于等于60分,小于70分;—    E:小于60分。2.关键技术本例共有五个分支,使用If…Then…Else这种二路分支结构也可完成,但需要复杂的嵌套结构才能解决该问题。其实VBA中提供了一种If…Then…ElseIf的多分支结构,其语法格式如下:If 逻辑表达式1 Then语句序列1ElseIf 逻辑表达式2 Then语句序列2.ElseIf 逻辑表达式3 Then语句序列3... …Else语句序列nEnd If在以上结构中,可以包括任意数量的ElseIf子句和条件,ElseIf子句总是出现在Else子句之前。VBA首先判断“逻辑表达式1”的值。如果它为False,再判断“逻辑表达式2”的值,依此类推,当找到一个为True的条件,就会执行相应的语句块,然后执行End If后面的代码。如果所有“逻辑表达式”都为False,且包含Else语句块,则执行Else语句块。其流程图如图3-18所示。图3-18  If…Then…ElseIf语句流程图3.编写代码(1)在Excel中打开成绩表。(2)按快捷键“Alt+F11”进入VBE开发环境。(3)单击“插入/模块”命令向工程中插入一个模块,并编写以下VBA代码:Sub 评定等级()Dim i As IntegerFor i = 3 To 11t = Sheets(1).Cells(i, 2).Value   '取得成绩If t >= 90 Thenj = "A"ElseIf t >= 80 Thenj = "B"ElseIf t >= 70 Thenj = "C"ElseIf t >= 60 Thenj = "D"Elsej = "E"End IfSheets(1).Cells(i, 3) = jNextEnd Sub(4)返回Excel操作界面,在成绩表旁边增加一个按钮,并指定执行宏“评定等级”。(5)单击“评定等级”按钮,即可在成绩表的C列显示出各成绩对应的等级,如图3-17所示。例023  计算个人所得税1.案例说明在工资管理系统中,需要计算员工应缴纳的个人所得税。个人所得税税额按5%至45%的九级超额累进税率计算应缴税额,税率表如图3-19所示。个人所得税的计算公式为:应纳个人所得税税额=应纳税所得额×适用税率-速算扣除数本例根据工资表中的相应数据计算出纳税额,并填充在工资表对应的列中。

图3-19  个人所得税税率表2.关键技术本例中计算个人所得税时共有九个分支。这时可在If…Then…ElseIf结构中添加多个ElseIf块来进行各分支的处理。对于多分支结构,可使用Select Case语句。Select Case语句的功能与If…Then…Else语句类似,但在多分支结构中,使用Select Case语句可使代码简洁易读。Select Case结构的语法格式如下:Select Case 测试表达式Case 表达式列表1语句序列1Case 表达式列表2语句序列2…   …Case Else语句序列nEnd Select在以上结构中,首先计算出“测试表达式”的值,然后,VBA将表达式的值与结构中的每个Case的值进行比较。如果相等,就执行与该Case语句下面的语句块,执行完毕再跳转到End Select语句后执行。其流程图如图3-20所示。图3-20  Select Case语句流程图在Select Case结构中,“测试表达式”通常是一个数值型或字符型的变量。“表达式列表”可以是一个或几个值的列表。如果在一个列表中有多个值,需要用逗号将各值分隔开。表达式列表可以按以下几种情况进行书写:—    表达式:表示一些具体的取值。例如:Case 10,15,25。—    表达式A To 表达式B:表示一个数据范围。例如,Case 7 To 17表示7~17之间的值。—    Is 比较运算符表达式:表示一个范围。例如,Case Is>60 表示所有大于90的值。—    以上三种情况的混合。例如,Case 4 To 10, 15, Is>20。3.编写代码(1)在Excel中打开工资表工作簿。(2)按快捷键“Alt+F11”进入VBE开发环境。(3)单击菜单“插入/模块”命令插入一个模块。(4)在模块中编写以下函数,用来计算所得税:Function 个人所得税(curP As Currency)Dim curT As CurrencycurP = curP – 1600   '1600为扣除数If curP > 0 ThenSelect Case curPCase Is <= 500curT = curP * 0.05Case Is <= 2000curT = (curP - 500) * 0.1 + 25Case Is <= 5000curT = (curP - 2000) * 0.15 + 125Case Is <= 20000curT = (curP - 5000) * 0.2 + 375Case Is <= 40000curT = (curP - 20000) * 0.25 + 1375Case Is < 60000curT = (curP - 40000) * 0.3 + 3375Case Is < 80000curT = (curP - 60000) * 0.35 + 6375Case Is < 100000curT = (curP - 80000) * 0.4 + 10375Case ElsecurT = (curP - 100000) * 0.45 + 15375End Select个人所得税 = curTElse个人所得税 = 0End IfEnd Function(5)在模块中编写“计算”子过程,计算工资表中每个员工应缴所得税额,并填写在对应的列中。Sub 计算()For i = 4 To 9Sheets(1).Cells(i, 8).Value = 个人所得税(Sheets(1).Cells(i, 6).Value)NextEnd Sub(6)返回到Excel环境中,在工资表下方插入一个按钮,为按钮指定宏为“计算”。(7)单击“计算”按钮,可计算出每个员工的所得税额,如图3-21所示。

图3-21  计算所得税3.3  循环结构在实际开发的应用系统中,经常需要重复执行一条或多条语句。这种结构称为循环结构。循环结构的思想是利用计算机高速处理运算的特性,重复执行某一部分代码,以完成大量有规则的重复性运算。VBA提供了多个循环结构控制语句:Do…Loop结构、While…Wend结构、For…Next结构、For Each…Next结构。例024  密码验证1.案例说明在信息管理系统中,很多时候都需要用户进行登录操作。在登录操作时要求用户输入密码,一般都要给用户三次机会,每次的输入过程和判断过程都相同。本例使用Do…Loop循环完成密码验证过程。2.关键技术在VBA中,最常用的循环语句是Do…Loop循环。循环结构Do While…Loop的语法格式如下:Do While 逻辑表达式语句序列1[Exit Do][语句序列2]Loop其中Do While和Loop为关键字,在Do While和Loop之间的语句称为循环体。当VBA执行这个Do循环时,首先判断“逻辑表达式”的值,如果为False(或零),则跳过所有语句,执行Loop的下一条语句,如果为True(或非零),则执行循环体,当执行到Loop语句后,又跳回到Do While语句再次判断条件。在循环体中如果包含有Exit Do语句,当执行到Exit Do语句,马上跳出循环,执行Loop的下一条语句。其流程图如图3-22所示。图3-22  Do While…Loop流程图VBA的Do…Loop循环有4种结构,分别如下:—    Do While…Loop循环:先测试条件,如果条件成立则执行循环体。—    Do…Loop While循环:先执行一遍循环体,再测试循环条件,如果条件成立则执行循环体。—    Do Until…Loop循环:先测试条件,如果条件不成立则执行循环体。—    Do…Loop Until循环:先执行一遍循环体,再测试循环条件,如果条件不成立则执行循环体。3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE开发环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下VBA代码:Sub login()Dim strPassword As String    '保存密码Dim i As Integer             '输入密码的次数DostrPassword = InputBox("请输入密码") '输入密码If strPassword = "test" Then  '判断密码是否正确Exit Do                '退出循环ElseMsgBox ("请输入正确的密码!")End Ifi = i + 1Loop While i < 3If i >= 3 Then   '超过正常输入密码次数MsgBox "非法用户,系统将退出!"Application.QuitElseMsgBox "欢迎你使用本系统!"End IfEnd Sub

(4)返回Excel操作界面,在工作表中插入一个按钮,设置提示文字为“密码验证”,并为该按钮指定执行的宏为“login”。(5)单击“密码验证”按钮,弹出如图3-23所示对话框,输入密码后单击“确定”按钮进行密码的验证。例025  求最小公倍数和最大公约数1.案例说明几个数公有的倍数叫做这几个数的公倍数,其中最小的一个叫做这几个数的最小公倍数。如12、18、20这三个数的最小公倍数为180。最大公约数是指某几个整数的共有公约数中最大的那个数。如2、4、6这三个数的最大公约数为2。本例使用辗转相除法求两个自然数m、n的最大公约数和最小公倍数。2.关键技术本例首先求出两数m、n的最大公约数,再将m、n数的乘积除以最大公约数,即可得到最小公倍数。求最大公约数的算法流程图如图3-24所示。图3-24  最大公约数算法流程图本例使用Do…Loop循环,并且没有设置循环条件。一般情况下,这种循环是一个死循环(也就是说程序将一直循环下去),因此,在这种循环结构中必须添加一个判断语句,当达到指定的条件时退出循环。如本例中使用以下语句退出循环:If r = 0 Then Exit Do3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下子过程:Sub 最小公倍数和最大公约数()Dim m As Integer, n As IntegerDim m1 As Integer, n1 As IntegerDim t As Integerm = InputBox("输入自然数m:")n = InputBox("输入自然数n:")m1 = mn1 = nIf m1 < n1 Thenm1 = nn1 = m '交换m和n的值End IfDor = m1 Mod n1If r = 0 Then Exit Dom1 = n1n1 = rLoopstr1 = m & "," & n & "的最大公约数=" & n1 & vbCrLfstr1 = str1 & "最小公倍数=" & m * n / n1MsgBox str1End Sub(4)返回Excel操作环境,向工作表中插入一个按钮,为按钮指定执行上步创建的宏。(5)单击按钮,弹出如图3-25所示的输入提示框,分别输入两个数后,得到如图3-26所示的结果。

图3-25  输入数据                      图3-26  最大公约数和最小公倍数例026  输出ASCII码表1.案例说明目前计算机中用得最广泛的字符集及其编码,是由美国国家标准局(ANSI)制定的ASCII码。ASCII码由8位二进制组成,一共可包含256个符号。本例使用循环语句输出ASCII中的可见字符,如图3-27所示。

图3-27  ASCII码表2.关键技术使用Do…Loop循环时,可以不知道循环的具体次数。如果知道循环的次数,可以使用For…Next循环语句来执行循环。For循环的语法如下:For 循环变量=初始值 To 终值 [Step 步长值]语句序列1[Exit For][语句序列2]Next [循环变量]在For循环中使用循环变量来控制循环,每重复一次循环之后,循环变量的值将与步长值相加。步长值可正可负,如果步长值为正,则初始值必须小于等于终值,才执行循环体,否则退出循环。如果步长值为负,则初始值必须大于等于终值,这样才能执行循环体。如果没有设置Step,则步长值默认为1。For…Next循环结构的流程图如图3-28所示。For循环一般都可计算出循环体的执行次数,计算公式如下:循环次数=[(终值-初值)/步长值]+1这里用中括号表示取整。在事先不知道循环体需要执行多少次时,应该用Do循环。而在知道循环体要执行的次数时,最好使用For…Next循环。图3-28  For…Next流程图3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下子过程:Sub ascii()Dim a As Integer, i As Integeri = 3For a = 32 To 126Sheets(1).Cells(i, 1) = aSheets(1).Cells(i, 2) = Chr(a)i = i + 1NextEnd Sub(4)返回Excel操作环境,向工作表中插入一个按钮,为按钮指定执行上步创建的宏。(5)单击按钮,得到如图3-27所示的结果。例027  计算选中区域数值之和1.案例说明在某些情况下,需要统计工作表中选定区域数值单元格的数值之和(例如,临时查看应发奖金之和),在Excel的状态栏就可查看选中单元格的数值之和。本例编写VBA代码,使用循环结构来完成该项功能。2.关键技术用户在Excel工作表中选定单元格的数量是不固定的,若需统计所选单元格数值之和,这时可使用For Each循环来进行处理,对选中区域的每个单元格进行判断,然后再累加数值单元格的值。For Each…Next循环语句的语法格式如下:For Each 元素 In 对象集合[语句序列1][Exit For][语句序列2]Next使用For Each循环结构,可在对象集合每个元素中执行一次循环体。如果集合中至少有一个元素,就会进入For Each循环体执行。一旦进入循环,便先针对“对象集合”中第一个元素执行循环中的所有语句。如果“对象集合”中还有其他的元素,则会针对它们执行循环中的语句,当“对象集合”中的所有元素都执行完了,便会退出循环,然后从Next语句之后的语句继续执行。在循环体中可以放置任意多个Exit For语句,随时退出循环。Exit For经常在条件判断之后使用,例如If…Then,并将控制权转移到紧接在Next之后的语句。3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下子过程:Sub 求和()Dim rDim t As LongFor Each r In SelectionIf IsNumeric(r.Value) Thent = t + r.ValueEnd IfNextMsgBox "所选区域数值之和为:" & tEnd Sub(4)返回Excel操作环境,向工作表中插入一个按钮,修改按钮的提示字符为“求和”,为按钮指定执行上步创建的宏“求和”。(5)在工作表“Sheet1”中输入数据,如图3-29左图所示。(6)拖动鼠标选中如图3-29左图所示数据区域,单击“求和”按钮,求和结果将显示在如图3-29右图所示对话框中。

图3-29  计算选中区域数值之和例028  换零钱法(多重循环)1.案例说明将十元钱换成1角、2角、5角、1元、2元、5元的零钱若干,求出一共有多少种方法进行计算?2.关键技术在VBA中,循环结构内的循环体又可以是循环结构,这种情况称为循环的嵌套。VBA允许在同一过程里嵌套多种类型的循环。在编写嵌套循环程序的代码时,一定要注意每个循环语句的配对情况。如图3-30所示,其中左图是正确的嵌套关系,第一个Next关闭了内层的For循环,而最后一个Loop关闭了外层的Do循环。同样,在嵌套的If语句中,End If语句自动与最靠近的前一个If语句配对。嵌套的Do…Loop结构的工作方式也是一样的,最内圈的Loop语句与最内圈的Do语句匹配。图3-30右图则是错误的嵌套关系。语句序列2图3-30  正确的嵌套(左)与错误的嵌套(右)3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)零钱换法最简单的算法是:使用多重循环,将10元钱能换成的各种可能都考虑进去(如10可换为100个1角,可换为50个2角,等等)。根据这种算法在模块中编写以下子过程:Sub 换零钱1()Dim t As IntegerFor i = 0 To 100                                     '1角For j = 0 To 50                                   '2角For k = 0 To 20                            '5角For l = 0 To 10                          '1元For m = 0 To 5                            '2元For n = 0 To 2                     '5元If i + 2 * j + 5 * k + 10 * l + 20 * m + 50 * n = 100 Thent = t + 1Sheets(1).Cells(t + 1, 1) = iSheets(1).Cells(t + 1, 2) = jSheets(1).Cells(t + 1, 3) = kSheets(1).Cells(t + 1, 4) = lSheets(1).Cells(t + 1, 5) = mSheets(1).Cells(t + 1, 6) = nEnd IfNextNextNextNextNextNextMsgBox "10元换为零钱共有" & t & "种方法!"End Sub(4)运行该子过程,Excel工作表中每一行将填写一种可能的换法,如图3-31所示。(5)因为换零钱的方法很多,根据计算机的速度不同该程序的运行速度也不同,最后将通过对话框显示出总的换法次数,如图3-32所示。

图3-31  零钱换法                               图3-32  换法总数(6)在循环嵌套中,内层循环体执行的次数等各外层循环数数之积,如本例代码内循环执行次数为:101×51×21×11×6×3=21417858次(7)对于嵌套循环,一般都可以对代码进行一定的优化,使程序的执行效率更高。本例最简单的优化代码如下:Sub 换零钱2()Dim t As LongFor j = 0 To 50                                  '2角For k = 0 To 20                               '5角For l = 0 To 10                        '1元For m = 0 To 5                       '2元For n = 0 To 2                        '5元t2 = 2 * j + 5 * k + 10 * l + 20 * m + 50 * nIf t2 <= 100 Thent = t + 1i = 100 - t2Sheets(1).Cells(t + 1, 1) = iSheets(1).Cells(t + 1, 2) = jSheets(1).Cells(t + 1, 3) = kSheets(1).Cells(t + 1, 4) = lSheets(1).Cells(t + 1, 5) = mSheets(1).Cells(t + 1, 6) = nEnd IfNextNextNextNextNextMsgBox "10元换为零钱共有" & t & "种方法!"End Sub(8)以上程序中内循环的执行数数如下:51×21×11×6×3=212058次可以看出减少最外层循环的101次,可使用内循环体提高100倍的执行效率。本例程序还有很多优化方法,这里就不再介绍。3.4  使用数组在程序中,如果要处理大量的数据,为每个数据定义一个变量将使程序变得很难阅读,并且代码很烦琐。对于大量有序的数据,可以使用数组对其进行存储和处理。在其他程序设计语言中,数组中的所有元素都必须为同样的数据类型,在VBA中,数组中各元素可以是相同的数据类型,也可以是不同的数据类型。例029  数据排序1.案例说明在Excel中可以方便地对单元格区域中的数据进行排序。本例使用VBA程序首先让用户输入10个数据,然后使用冒泡排序法对这10个数进行排序。2.关键技术在程序中处理大量数据时,使用数组来保存是比较好的方法。数组使用之前可以使用Dim、Static、Private或Public语句来声明。在VBA中,数组最大可以达到60维,最常用的是一维数组和二维数组。定义一维数组的语法格式如下:Dim 数组名([下界 To] 上界)  As 数据类型其中“下界”可以省略,只给出数组的上界(即可以使用的最大下标值),这时默认值为0,即数组的下标从0开始至定义的上界,如:Dim MyArray(10) As String定义了一个名为MyArray的数组,共有11个元素,分别为MyArray(0)、MyArray(1)、…、MyArray(10)。如果希望下标从1开始,可以通过Option Base语句来设置,其语法格式如下:Option Base 1使用该语句指定数组下标的默认下界,只能设为0或1。—

该语句只能出现在用户窗体或模块的声明部分,不能出现在过程中,且必须放在数组定义之前。3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下代码:Option Base 1Sub 数据排序()Dim i As Integer, j As IntegerDim kDim s(10) As IntegerFor i = 1 To 10s(i) = Application.InputBox("输入第" & i & "个数据:", "输入数组", , , , , , 1)NextFor i = 1 To 9For j = i + 1 To 10If s(i) < s(j) Thent = s(i)s(i) = s(j)s(j) = tEnd IfNextNextFor Each k In sDebug.Print kNextEnd Sub在VBA中使用Inputbox函数接受用户输入数据时,返回的值为文本型。以上代码中使用了Application对象的InputBox方法来接受用户输入数据,该方法的语法格式如下:Application.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, Type)设置Type参数可指定返回的数据类型,如本例设置其值为2,则返回的值为数值型。(4)运行上面的宏,弹出如图3-33所示的对话框,提示用户输入数据。循环程序要求用户输入10个数据。(5)最后在“立即窗口”输出排序的结果,如图3-34所示。

图3-33  输入数据                             图3-34  排序结果例030  彩票幸运号码1.案例说明本例结合数组和随机函数的知识,生成指定数量的彩票幸运号码。本例生成的彩票号码每注由7位数构成,首先让用户输入产生的注数,再使用循环语句生成指定注数的号码。2.关键技术本例代码中使用了两个关键技术:动态数组和随机函数。(1)动态数组本例使用二维数组保存所有的彩票号码,二维数组的定义格式如下:Dim 数组名(第1维上界, 第2维上界)  As 数据类型或Dim 数组名(第1维下界 To 第1维上界, 第2维下界 To 第2维上界)  As 数据类型在本例中,因为生成的彩票数量是由用户输入的数据决定的。因此这里使用动态数组。动态数组是指在程序运行时大小可以改变的数组,定义动态数组一般分两个步骤:首先在用户窗体、模块或过程中使用Dim或Public声明一个没有下标的数组(不能省略括号),然后在过程中用ReDim语句重定义该数组的大小。ReDim语句在过程级别中使用,用于为动态数组变量重新分配存储空间。其语法格式如下:ReDim [Preserve] 数组名(下标) [As 数据类型]可以使用ReDim语句反复地改变数组的元素以及维数的数目,但是不能在将一个数组定义为某种数据类型之后,再使用ReDim将该数组改为其他数据类型,除非是Variant所包含的数组。在默认情况下,使用ReDim语句重定义数组的维数和大小时,数组中原来保存的值将全部消失,如果使用Preserve关键字,当改变原有数组最后一维的大小时,可以保持数组中原来的数据。如果使用了Preserve关键字,就只能重新定义数组最后一维的大小,并不能改变维数的数目。(2)随机函数Rnd随机函数Rnd可返回小于1但大于或等于0的一个小数。其语法格式如下:Rnd[(number)]可选的number参数是Single或任何有效的数值表达式。根据number参数值的不同,Rnd函数生成的随机数也不同:—    number<0,则每次使用相同的number作为随机数种得到的相同结果。—    number>0,则将生成随机序列中的下一个随机数。—    number=0,则将生成最近生成的数。—    省略number,则生成序列中的下一个随机数。—

在调用Rnd之前,先使用无参数的Randomize语句初始化随机数生成器,该生成器具有根据系统计时器得到的种子。为了生成某个范围内的随机整数,可使用以下公式:Int((上限 – 下限 + 1) * Rnd + 下限)3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下代码:Option Base 1Sub 幸运号码()Dim n As Integer, i As Integer, j As IntegerDim l() As Integern = Application.InputBox("请输入需要产生幸运号码的数量:", "幸运号码", , , , , , 2)ReDim l(n, 7) As IntegerFor i = 1 To nFor j = 1 To 7Randomizel(i, j) = Int(10 * Rnd)NextNextFor i = 1 To nFor j = 1 To 7Debug.Print l(i, j);NextDebug.PrintNextEnd Sub(4)运行上面的宏,弹出如图3-35所示的对话框,提示用户输入数据。输入生成幸运号码的数量。(5)单击“确定”按钮后在“立即窗口”输出生成的幸运号码,如图3-36所示。

图3-35  输入数据                         图3-36  生成幸运号码例031  用数组填充单元格区域1.案例说明在Excel中要处理大量数据时,可使用循环从各单元格读入数据,经过加工处理后再写回单元格区域中。这种方式比在数组中处理数据的速度要慢。因此,如果有大量的数据需要处理时,可先将数据保存到数组中,经过加工处理后,再将数组的数据填充到单元格区域。本例演示将二维数组中的数据填充到工作表中的方法。2.关键技术在Excel工作表中,工作表是一个二维结构,由行和列组成。这种特性与二维数组类似,因此可以很方便地将工作表单元格区域与二维数组之间进行转换。通过以下语句可将单元格区域赋值给一个二维数组:myarr = Range(Cells(1, 1), Cells(5, 5))反过来,也可将二维数组中的值快速的赋值给一个单元格区域,如以下语句将二维数组myarr中的值赋值给单元格区域Rng:Rng.Value = arr3.编写代码(1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。(2)单击菜单“插入/模块”命令向工程中插入一个模块。(3)在模块中编写以下代码:Option Base 1Sub 数组填充单元格区域()Dim i As Long, j As LongDim col As Long, row As LongDim arr() As Longrow = Application.InputBox(prompt:="输入行数:", Type:=2)col = Application.InputBox(prompt:="输入列数:", Type:=2)ReDim arr(row, col)For i = 1 To rowFor j = 1 To colarr(i, j) = (i - 1) * col + jNextNextSet Rng = Sheets(1).Range(Cells(1, 1), Cells(row, col))Rng.Value = arrEnd Sub(4)返回Excel操作环境,向工作表中添加一个按钮,设置提示文字为“填充数据”,指定该按钮的宏为“数组填充单元格区域”。(5)单击“填充数据”按钮,弹出如图3-37所示对话框,分别输入数组的行和列。

图3-37  输入行和列(6)VBA代码生成一个二维数组,最后填充到工作表中,如图3-38所示。

图3-38  填充数据通过Excel相关对象可对工作表中的数据进行操作,如处理单元格区域的公式、对数据进行查询、排序、筛选等操作。本章演示使用VBA进行处理数据的实例。12.1  处理公式使用VBA代码可对工作表中的公式单元格进行处理,如判断单元格是否包含公式、复制公式、将单元格公式转换为具体的值等。例254  判断单元格是否包含公式1.案例说明打开本例工作簿如图12-1所示,单击左上角的“公式单元格”按钮,将弹出如图12-1右图所示的提示框,显示当前工作表中定义了公式的单元格。

图12-1  显示有公式的单元格2.关键技术本例使用Range对象的HasFormula属性来判断指定单元格是否包含公式,如果区域中所有单元格均包含公式,则该属性值为True;如果所有单元格均不包含公式,则该属性值为False;其他情况下为null。本例对当前单元格区域中的单元格逐个进行判断,并显示出具有公式的单元格。3.编写代码“公式单元格”按钮的VBA代码如下:Sub 显示公式单元格()Dim rng As RangeSet rng = ActiveSheet.Range("A1").CurrentRegionFor Each c In rng.CellsIf c.HasFormula ThenMsgBox "单元格" & c.Address & " 定义了公式!"End IfNextEnd Sub例255  自动填充公式1.案例说明打开本例工作簿如图12-2所示,在如图所示工作表中,单元格J3和D16定义了公式,单击“填充公式”按钮,单元格J3的公式将向下填充,单元格D16的公式向右填充,结果如图12-3所示。

图12-2  原工作表

图12-3  复制公式2.关键技术本例使用Range对象的AutoFill方法,对指定区域中的单元格执行自动填充。该方法的语法格式如下:表达式.AutoFill(Destination, Type)该方法有两个参数,其含义如下:—    Destination:要填充的单元格。目标区域必须包括源区域。—    Type:指定填充类型。该填充类型可使用xlAutoFillType枚举类型,其值如表12-1所示。表12-1  xlAutoFillType枚举值名    称值描    述xlFillCopy1将源区域的值和格式复制到目标区域,如有必要可重复执行xlFillDays5将星期中每天的名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行xlFillDefault0Excel确定用于填充目标区域的值和格式xlFillFormats3只将源区域的格式复制到目标区域,如有必要可重复执行xlFillMonths7将月名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行xlFillSeries2将源区域中的值扩展到目标区域中,形式为系列(如,“1, 2”扩展为“3, 4, 5”)。格式从源区域复制到目标区域,如有必要可重复执行xlFillValues4只将源区域的值复制到目标区域,如有必要可重复执行xlFillWeekdays6将工作周每天的名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行xlFillYears8将年从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行xlGrowthTrend10将数值从源区域扩展到目标区域中,假定源区域的数字之间是乘法关系(如,“1, 2,”扩展为“4, 8, 16”,假定每个数字都是前一个数字乘以某个值的结果)。格式从源区域复制到目标区域,如有必要可重复执行xlLinearTrend9将数值从源区域扩展到目标区域中,假定数字之间是加法关系(如,“1, 2,”扩展为“3, 4, 5”,假定每个数字都是前一个数字加上某个值的结果)。格式从源区域复制到目标区域,如有必要可重复执行3.编写代码“填充公式”按钮的VBA代码如下:Sub 填充公式()Dim i As Long, j As LongWith Range("A1").CurrentRegioni = .Rows.Count - 1j = .Columns.Count - 1End WithRange("J3").AutoFill _Destination:=Range(Cells(3, 10), Cells(i, 10))Range("D16").AutoFill _Destination:=Range(Cells(16, 4), Cells(16, j))End Sub以上代码首先获取当前区域的行和列,接着使用AutoFill方法在垂直方向和水平方向填充相应的公式。例256  锁定和隐藏公式1.案例说明打开本例工作簿如图12-4所示,单击“锁定隐藏公式”按钮,当前工作表中的所有公式单元格将被锁定,不允许用户修改,而其他单元格的数据用户可进行修改。同时,公式单元格定义的公式将被隐藏,单击选取具有公式的单元格时,将不会显示公式。

图12-4  锁定和隐藏公式2.关键技术要锁定和隐藏单元格,可通过Range对象的以下两个属性来进行设置。—    Locked属性:指明对象是否已被锁定。—    FormulaHidden属性:指明在工作表处于保护状态时是否隐藏公式。当设置以上两个属性为True时,对指定区域锁定和隐藏。但要真正锁定和隐藏单元格,必须使用Protect方法对工作表进行保护。3.编写代码“锁定隐藏公式”按钮的VBA代码如下:Sub 锁定和隐藏公式()If ActiveSheet.ProtectContents = True ThenMsgBox "工作表已保护!"Exit SubEnd IfWorksheets("Sheet1").Range("A1").CurrentRegion.SelectSelection.Locked = FalseSelection.FormulaHidden = FalseSelection.SpecialCells(xlCellTypeFormulas).SelectSelection.Locked = TrueSelection.FormulaHidden = TrueWorksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=TrueWorksheets("Sheet1").EnableSelection = xlNoRestrictionsEnd Sub例257  将单元格公式转换为数值1.案例说明打开本例工作簿如图12-5所示,在当前工作表中单元格区域“J3:J15”和“D16:I15”中都定义了公式,单击选择这两个区域中的任意一个单元格,编辑栏中将显示该单元格的公式。单击工作表左上角的“公式转为数值”按钮,当前工作表中所有公式单元格的公式定义都将被具体计算值所替代,这时再修改引用单元格的值,这两个区域的值不会再变化了。

图12-5  将公式转为数值2.关键技术将单元格公式转换为计算结果的表示方法很简单,只需通过以下的赋值运算即可:rng.Value = rng.Value以上赋值语句中,rng表示Range对象,该语句首先通过右侧的表达式rng.Value获取指定单元格的值(如果是公式,则获取公式的计算结果),再将该值赋值给单元格的Value变量,从而取代单元格原有的内容(公式)。3.编写代码“公式转为数值”按钮的VBA代码如下:Sub 公式转为数值()Dim rng As Range, c As RangeSet rng = ActiveSheet.Range("A1").CurrentRegionFor Each c In rng.CellsIf c.HasFormula Thenc.Value = c.ValueEnd IfNextEnd Sub以上代码首先获取工作表的当前区域,再逐个单元格判断,如果单元格有公式,则进行转换。例258  删除所有公式1.案例说明在Excel中,当单元格的数据发生改变后,引用该单元格的公式单元格的值也会随之变化。有时希望经过计算后,具有公式的单元格的值不再随着引用单元格而变化。这时可以删除工作表中的公式,取消与引用单元格的关联。打开本例工作簿如图12-6所示,在如图所示的工作表中部分单元格具有公式,单击选择单元格I16,在编辑栏中可看到具体的公式。

图12-6  具有公式的工作表单击“删除所有公式”按钮,将打开如图12-7所示的对话框,询问用户是否删除提示工作簿中的所有公式,单击“是”按钮工作簿中各工作表中的公式都将被删除,如图12-8所示选中单元格I16,编辑栏中可以看到显示的是具体的值,公式已被删除。

图12-7  确认操作

图12-8  删除公式的工作表2.关键技术本例代码与上例类似,不同的是本例将对所有打开工作簿进行处理,对每个工作簿的每张工作表进行循环,将具有公式的单元格转换为具体的数值。3.编写代码“删除所有公式”按钮的VBA代码如下:Sub 删除所有公式()Dim wb1 As Workbook, ws1 As WorksheetDim rng As Range, rng1 As RangeFor Each wb1 In WorkbooksWith wb1If MsgBox("是否删除工作簿“" & wb1.Name & "”中的所有公式?", _vbQuestion + vbYesNo) = vbYes ThenFor Each ws1 In .WorksheetsOn Error Resume NextSet rng1 = ws1.UsedRange.SpecialCells(xlCellTypeFormulas)'获取公式单元格区域引用For Each rng In rng1rng.Value = rng.Value  '将公式转换成数值NextNextEnd IfEnd WithNextEnd Sub例259  用VBA表示数组公式1.案例说明打开本例工作簿如图12-9所示。在Excel中,可以通过定义数组公式计算销售总金额。但是如果销售日报表中销售商品的数量不确定(占用表格的行是动态的),使用固定的数组公式就不太方便。

图12-9  销售日报表本例使用VBA动态定义数组公式,在图12-9所示工作表中输入数据,然后单击“汇总金额”按钮,在单元格F5中将根据录入数据的行数自动生成数组公式,如图12-10所示,在编辑栏可看到数组公式为:{=SUM(B4:B9*C4:C9)}2.关键技术使用Range对象的FormulaArray属性,可获取或设置区域的数组公式。如果指定区域不包含数组公式,则该属性返回null。

图12-10  生成数组公式3.编写代码“汇总金额”按钮的VBA代码如下:Sub 汇总金额()Dim r As Longr = ActiveSheet.Range("A3").End(xlDown).RowRange("F5").FormulaArray = "=SUM(B4:B" & r & "*C4:C" & r & ")"End Sub12.2  数据查询在Excel中,数据查询是最常用的操作。在“开始”选项卡的“编辑”组中单击“查找和选择”按钮,从下拉的菜单按钮中选择相应的命令即可进行查询操作。在VBE中,可使用Find方法进行查询相关的操作,本节实例演示查询数据的VBA代码。例260  查找指定的值1.案例说明打开本例工作簿如图12-11所示,单击左上角的“查找”按钮,弹出“查找”对话框如图12-12所示,在该对话框中输入要查找的值(如本例中输入200),单击“确定”按钮,查找的结果显示在如图12-13所示的对话框中,同时工作表中对应单元格也加亮显示,如图12-14所示。

图12-11  查找工作表                         图12-12  输入查找值

图12-13  查找结果                             图12-14  加亮显示2.关键技术本例的查找使用了Range对象的两个方法:Find方法和FindNext方法。(1)Find方法使用该方法可以在区域中查找特定信息。其语法格式如下:表达式.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)该方法的参数很多,其中What参数是必须指定的,其余参数都可省略。各参数的含义如下:—    What:要搜索的数据。可为字符串或任意Excel数据类型。—    After:表示搜索过程将从其之后开始进行的单元格。此单元格对应于从用户界面搜索时的活动单元格的位置。After必须是区域中的单个单元格。要记住搜索是从该单元格之后开始的;直到此方法绕回到此单元格时,才对其进行搜索。如果不指定该参数,搜索将从区域的左上角的单元格之后开始。—    LookIn:信息类型。—    LookAt:设置匹配文本的方式。可为常量xlWhole(匹配全部搜索文本)或xlPart(匹配任一部分搜索文本)。—    SearchOrder:指定搜索区域的次序。可为常量xlByRows(按行)或xlByColumns(按列)搜索。—    SearchDirection:搜索的方向。可为常量xlNext(在区域中搜索下一匹配值)或xlPrevious(在区域中搜索上一匹配值)。—    MatchCase :如果为True,则搜索区分大小写。默认值为False。—    MatchByte:只在已经选择或安装了双字节语言支持时适用。如果为True,则双字节字符只与双字节字符匹配。如果为False,则双字节字符可与其对等的单字节字符匹配。—    SearchFormat:搜索的格式。使用该方法将返回一个Range对象,它代表第一个在其中找到该信息的单元格。如果未发现匹配项,则返回Nothing。Find方法不影响选定区域或当前活动的单元格。—

每次使用此方法后,参数LookIn、LookAt、SearchOrder和MatchByte的设置都将被保存。如果下次调用此方法时不指定这些参数的值,就使用保存的值。设置这些参数将更改“查找”对话框中的设置,如果省略这些参数,更改“查找”对话框中的—   设置将更改使用的保存值。要避免出现这一问题,每次使用此方法时最好明确设置这些参数。(2)FindNext方法FindNext方法继续由Find方法开始的搜索。查找匹配相同条件的下一个单元格,并返回表示该单元格的Range对象。该操作不影响选定内容和活动单元格。其语法格式如下:表达式.FindNext(After)参数After指定一个单元格,查找将从该单元格之后开始。此单元格对应于从用户界面搜索时的活动单元格位置。—

After必须是查找区域中的单个单元格。搜索是从该单元格之后开始的;直到本方法环绕到此单元格时,才检测其内容。如果未指定本参数,查找将从区域的左上角单元格之后开始。当查找到指定查找区域的末尾时,FindNext方法将环绕至区域的开始继续搜索。发生环绕后,为停止查找,可保存第一次找到的单元格地址,然后测试下一个查找到的单元格地址是否与其相同。3.编写代码“查找”按钮的VBA代码如下:Sub 查找指定值()Dim result As String, str1 As String, str2 As StringDim c As Rangeresult = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)If result = "False" Or result = "" Then Exit SubApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseWith ActiveSheet.CellsSet c = .Find(result, , , xlWhole, xlByColumns, xlNext, False)If Not c Is Nothing Thenstr1 = c.AddressDoc.Interior.ColorIndex = 4 '加亮显示str2 = str2 & c.Address & vbCrLfSet c = .FindNext(c)Loop While Not c Is Nothing And c.Address <> str1End IfEnd WithMsgBox "查找到指定数据在以下单元格中:" & vbCrLf & vbCrLf _& str2, vbInformation + vbOKOnly, "查找结果"Application.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub以上代码首先让用户输入查找的值,接着使用Find方法查找第一个满足条件的单元格,再使用循环查找当前工作簿中下一个满足条件的单元格,并在循环中对满足条件的单元格设置不同的底纹,以突出显示。例261  带格式查找1.案例说明打开本例工作簿如图12-15所示,单击左上角的“查找指定格式”按钮,单元格A2将被选中,并填上不同的底色。

图12-15  带格式查找2.关键技术本例使用Application对象的FindFormat属性,设置要查找的单元格格式类型的搜索条件,然后使用Find方法按格式进行查找。3.编写代码“查找指定格式”按钮的VBA代码如下:Sub 查找指定格式()With Application.FindFormat.Font.Name = "宋体".FontStyle = "Bold".Size = 11End WithCells.Find(what:="", SearchFormat:=True).ActivateSelection.Interior.ColorIndex = 4    '加亮显示End Sub以上代码首先使用FindFormat属性设置查找的格式条件,接着使用Find方法按格式查找并激活满足条件的单元格,最后加亮显示激活单元格。例262  查找上一个/下一个数据1.案例说明打开本例工作簿如图12-16所示,单击右上角的“查找”按钮,将弹出输入查找条件对话框,在对话框中输入查找条件单击“确定”按钮,即可在当前工作表中查找满足条件的单元格,找到满足条件的单元格后,选中该单元格。单击“向前查找”或“向后查找”按钮,可从当前单元格向前或向后查找满足前面设置条件的单元格,并选中该单元格。如果在使用“查找”按钮输入查找条件之前,就直接单击“向前查找”或“向后查找”按钮,也将弹出如图12-17所示的“查找”对话框输入查询条件。

图12-16  查找上一下/下一个数据                      图12-17  输入查找条件要重设查找条件,单击“查找”按钮打开如图12-17所示对话框即可。2.关键技术(1)FindNext方法使用该方法继续由Find方法开始的搜索。查找匹配相同条件的下一个单元格,并返回表示该单元格的Range对象。该方法的语法格式如下:表达式.FindNext(After)参数After指定一个单元格,查找将从该单元格之后开始。此单元格对应于从用户界面搜索时的活动单元格位置。After必须是查找区域中的单个单元格。搜索是从该单元格之后开始的;直到本方法环绕到此单元格时,才检测其内容。如果未指定本参数,查找将从区域的左上角单元格之后开始。当查找到指定查找区域的末尾时,本方法将环绕至区域的开始继续搜索。发生环绕后,为停止查找,可保存第一次找到的单元格地址,然后测试下一个查找到的单元格地址是否与其相同。(2)FindPrevious方法该方法继续由Find方法开始的搜索。查找匹配相同条件的上一个单元格,并返回代表该单元格的Range对象。其语法格式如下:表达式.FindPrevious(After)参数After指定一个单元格,查找将从该单元格之前开始。此单元格对应于从用户界面搜索时的活动单元格的位置。3.编写代码(1)在VBE中插入一个模块,使用以下代码声明一个模块变量:Dim c As Range(2)“查找”按钮的VBA代码如下:Sub 查找()result = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)If result = "False" Or result = "" Then Exit SubSet c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)If Not c Is Nothing Thenc.ActivateEnd IfEnd Sub以上代码首先提示用户输入查询条件,再使用Find方法向下查找。(3)“向前查找”按钮的VBA代码如下:Sub 向前查找()Dim result As String, str1 As String, str2 As StringIf c Is Nothing Thenresult = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)If result = "False" Or result = "" Then Exit SubSet c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlPrevious, False)ElseSet c = ActiveSheet.Cells.FindPrevious(c)End IfIf Not c Is Nothing Thenc.ActivateEnd IfEnd Sub以上代码首先判断模块变量c是否为空(判断执行该子过程之前是否设置了查询条件),若为空,则打开对话框让用户输入查询条件,并使用Find方法向前查找。若模块变量c不为空,则调用FindPrevious方法向前查找。(4)“向后查找”按钮的VBA代码如下:Sub 向后查找()Dim result As String, str1 As String, str2 As StringIf c Is Nothing Thenresult = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)If result = "False" Or result = "" Then Exit SubSet c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)ElseSet c = ActiveSheet.Cells.FindNext(c)End IfIf Not c Is Nothing Thenc.ActivateEnd IfEnd Sub例263  代码转换1.案例说明打开本例工作簿如图12-18所示,在单元格C3中输入“101”,按回车键或Tab键后,单元格C3中输入的值将转换为“财务部”,如图12-19所示。

图12-18  输入代码单击工作表的“编码”标签,可看到编码表中编码与名称的对应关系,如图12-20所示。

图12-19  转换代码                                   图12-20  编码表2.关键技术本例使用查表的方法,将工作表中指定列中输入的代码转换为对应的值。在如图12-20所示的“编码”表中输入编码内容。本例的关键技术是使用工作表事件Change事件来进行代码的转换。当用户更改工作表中的单元格,或外部链接引起单元格的更改时发生Change事件。该事件的参数Target为数据正在被更改的区域。3.编写代码在工作表“Sheet1”的Change事件中编写以下VBA代码:Private Sub Worksheet_Change(ByVal Target As Range)Dim t, rng As Range, i As Long, c As RangeIf Target.Column = 3 And Target.Row > 2 And Target.Value <> "" Thent = Target.ValueWith Worksheets("编码")i = .Range("A1").End(xlDown).RowSet rng = .Range(.Cells(2, 1), .Cells(i, 1))Set c = rng.Find(what:=t)If c Is Nothing Then Exit SubTarget.Value = c.Offset(0, 1).ValueEnd WithEnd IfEnd Sub以上代码首先对更改单元格的行和列进行判断,如果是第3列第2行以下单元格,则执行编码转换的代码。在转换代码时先获取更改单元格的值,再从“编码”工作表中查找相应的编码,并将查到的编码对应的名称赋值给当前单元格,完成代码的转换。例264  模糊查询1.案例说明打开本例工作簿如图12-21所示,单击“模糊查询”按钮,弹出如图12-22所示的对话框,在对话框中输入查询条件“刘”,单击“确定”按钮,即可在工作表中查找含有“刘”字的单元格,并为单元格填充底色,如图12-23所示。

图12-21  模糊查询                                图12-22  查询条件

图12-23  加亮显示查询结果2.关键技术本例使用Like运算符进行模糊查询。Like运算符可用来比较两个字符串。其使用方法如下:result = string Like patternLike运算符的语法具有以下几个部分:—    result:运算的结果。—    string:被查询的字符串。—    pattern:查询字符串,该字符串可建立模式匹配。如果string与pattern匹配,则result为 True;如果不匹配,则result为False。但是如果string或pattern中有一个为Null,则result为Null。pattern中的字符可使用以下匹配模式:—    ?:可为任何单一字符。—    *:零个或多个字符。—    #:任何一个数字(0–9)。—    [charlist]:charlist中的任何单一字符。—    [!charlist]:不在charlist中的任何单一字符。在中括号([ ])中,可以用由一个或多个字符(charlist)组成的组与string中的任一字符进行匹配,这个组几乎包括任何一个字符代码以及数字。例如:MyCheck = "张三" Like "张*"      ' 返回 TrueMyCheck = "F" Like "[A-Z]"      ' 返回 TrueMyCheck = "F" Like "[!A-Z]"     ' 返回 FalseMyCheck = "a2a" Like "a#a"      ' 返回 True3.编写代码“模糊查询”按钮的VBA代码如下:Sub 模糊查询()Dim result As String, str1 As StringDim c As Range, rng As Rangeresult = Application.InputBox(prompt:="请输入要查找的值:", _Title:="模糊查找", Type:=2)If result = "False" Or result = "" Then Exit SubApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseSet rng = ActiveSheet.Range("A1").CurrentRegionstr1 = "*" & result & "*"For Each c In rng.CellsIf c.Value Like str1 Thenc.Interior.ColorIndex = 4End IfNextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub以上代码首先让用户输入查询条件,接着使用For循环逐个单元格进行比较,在比较时使用Like进行模糊查询,如果单元格中包含有指定条件的值,则设置单元格的底色。例265  网上查询快件信息1.案例说明使用本例代码可查询申通快递的快件投递情况。打开本例工作簿如图12-24所示,单击“查询快件”按钮打开如图12-25所示对话框,在对话框中输入快件编号,单击“确定”按钮,经过一段时间后得到查询结果如图12-26所示。

图12-24  查询工作表                       图12-25  输入快件编号

图12-26  查询结果—

本例使用的快件编号进行了处理(虚拟编号),在使用本例代码之前应确保计算已接入互联网。2.关键技术(1)QueryTable对象QueryTable对象代表一个利用从外部数据源(如SQL Server、Microsoft Access数据库、网络数据等)返回的数据生成的工作表表格。QueryTable对象是QueryTables集合的成员。(2)Add方法使用QueryTables集合对象的Add方法可新建一个查询表。其语法格式如下:表达式.Add(Connection, Destination, Sql)该方法参数的含义如下:—    Connection:查询表的数据源。可为连接数据库的连接字符串,也可以是一个Web查询。Web查询字符串的格式如下:URL;<url>其中“URL;”是必需的,字符串的其余部分作为Web查询的URL。—    Destination:查询表目标区域(生成的查询表的放置区域)左上角的单元格。目标区域必须位于QueryTables对象所在的工作表中。—    Sql:在ODBC数据源上运行的SQL查询字符串。当使用的数据源为ODBC数据源时,该参数可省略。(3)Refresh方法使用QueryTable对象的Refresh方法可更新外部数据区域(QueryTable)。该方法的语法格式如下:表达式.Refresh(BackgroundQuery)参数BackgroundQuery如果为True,则在数据库建立连接并提交查询之后,将控制返回给过程。QueryTable在后台进行更新。如果为False,则在所有数据被取回到工作表之后,将控制返回给过程。如果没有指定该参数,则由BackgroundQuery属性的设置决定查询模式。在Excel建立一个成功的连接之后,将存储完整的连接字符串,这样,以后在同一编辑会话中调用Refresh方法时就不会再显示提示。通过检查Connection属性的值可以获得完整的连接字符串。如果成功地完成或启动查询,则Refresh方法返回True;如果用户取消连接或参数对话框,该方法返回False。(4)使用Web查询在申能快递的网站上可查询快件的投递情况,在浏览器中输入以下网址:http://www.sto.cn/querybill/webform1.aspx?wen=&Submit2=%B2%E9%D1%AF将打开如图12-27所示的查询页面,在文本区中输入快件编号,单击“查询”按钮即可在网页上显示指定编号的快件投递情况。

图12-27  通过网页查询快件投递情况如果要在Excel中通过VBA查询快件投递情况,只需要将前面的URL地址中的“wen=”字符串后面加上快件编号即可。3.编写代码“查询快件”按钮的VBA代码如下:Sub 查询快件()Dim str As String, strURL As Stringstr = Application.InputBox(prompt:="请输入快件的编号:", _Title:="申通快件查询", Type:=2)If str = "False" Then Exit SubstrURL = "URL;http://www.sto.cn/querybill/webform1.aspx?wen="strURL=strURL & str & "&Submit2=%E6%9F%A5%E8%AF%A2"With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2")).Name = "abc".FieldNames = True.WebSelectionType = xlSpecifiedTables     '导入指定表.WebFormatting = xlWebFormattingNone      '不导入任何格式.WebTables = "1,2"                     '导入第一个和第二个表格中的数据.BackgroundQuery = True                   '查询异步执行(在后台执行).Refresh BackgroundQuery:=False           '更新数据End WithEnd Sub例266  查询基金信息1.案例说明打开本例工作簿,单击“查询基金信息”按钮,将在当前工作表中显示当前基金的信息如图12-28所示。

图12-28  基金信息2.关键技术在网站http://tw.stock.yahoo.com/us/worldinx.html中可查询基金的信息,如图12-29所示。在图12-29所示的基金信息网页中,上面用6个表格显示了一些超链接信息。最下方的表格显示具体各基金的数据,本例通过Web查询只需要获取下方的表格即可。通过查看HTML代码,可知该表格是第7个表格,所以需要设置QueryTable对象的WebTables属性为7。3.编写代码“查询基金信息”按钮的VBA代码如下:Sub 查询基金信息()Dim strURL As StringstrURL = "URL;http://fund.sohu.com/r/cxo.php"With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2")).Name = "worldinx".FieldNames = True.RowNumbers = False.FillAdjacentFormulas = False.PreserveFormatting = True.RefreshOnFileOpen = False.BackgroundQuery = True.RefreshStyle = xlInsertDeleteCells.SavePassword = False.SaveData = True.AdjustColumnWidth = True.RefreshPeriod = 0.WebSelectionType = xlSpecifiedTables.WebFormatting = xlWebFormattingNone.WebTables = "7".WebPreFormattedTextToColumns = True.WebConsecutiveDelimitersAsOne = True.WebSingleBlockTextImport = False.WebDisableDateRecognition = False.WebDisableRedirections = False.Refresh BackgroundQuery:=FalseEnd WithEnd Sub

图12-29  网站查询基金信息例267  查询手机所在地1.案例说明打开本例工作簿如图12-30所示,单击“手机所在地”按钮打开如图12-31所示对话框,输入手机号码后,单击“确定”按钮即可查询出手机所在地,如图12-32所示。2.关键技术本例与前面各例使用的Web查询不同。本例使用http://www.123cha.com/网站来查询手机所在地。其查询的HTML代码如下:<form method="post" action="index.php">请输入要查询的手机号码<b>前七位</b>或<b>全部</b>: <input type="text" name="query_mobile" size="18" class=tdc value= "">&nbsp;<input type="submit" value="查 询"></form>

图12-30  查询手机所在地                             图12-31  输入手机号码

图12-32  手机所在地从以上HTML代码可以看出,查询手机所在地使用的是POST方法(另一种方式是GET方式,前面两例使用的这种方式),这种方法将传递一个查询变量到目标页面,需要提供以下两个参数:—    第一个是查询页面,即QueryTable对象的Connection参数。该参数应该是<form>标签中的action关键字后面的页面。—    另一个参数是POST方法的字符串,用于向Web服务器输入数据以从Web查询中返回数据。该参数通过PostText属性进行设置,设置该属性的值应该按以下格式:.PostText = "query_mobile=13988888888"其中query_mobile为HTML页面中用户输入参数的域的名称。3.编写代码“手机所在地”按钮的VBA代码如下:Sub 查询手机所在地()Dim str As String, strURL As Stringstr = Application.InputBox(prompt:="请输入手机号码:", _Title:="手机所在地查询", Type:=2)If str = "False" Then Exit SubIf Left(str, 2) <> "13" ThenMsgBox "请输入正确的手机号码!", vbCritical + vbOKOnly, "提示"Exit SubEnd IfstrURL = "URL;http://www.123cha.com/sj/index.php"With ActiveSheet.QueryTables.Add(Connection:=strURL, Destination:=Range("A2")).Name = "cxo".PostText = "query_mobile=" & str.FieldNames = True.RowNumbers = False.FillAdjacentFormulas = False.PreserveFormatting = True.RefreshOnFileOpen = False.BackgroundQuery = True.RefreshStyle = xlInsertDeleteCells.SavePassword = False.SaveData = True.AdjustColumnWidth = True.RefreshPeriod = 0.WebSelectionType = xlSpecifiedTables.WebFormatting = xlWebFormattingNone.WebTables = "8".WebPreFormattedTextToColumns = True.WebConsecutiveDelimitersAsOne = True.WebSingleBlockTextImport = False.WebDisableDateRecognition = False.WebDisableRedirections = False.Refresh BackgroundQuery:=FalseEnd WithEnd Sub例268  使用字典查询1.案例说明打开本例工作簿如图12-33所示,在如图所示工作表中列出了员工的姓名,“工资”列为空。单击“查询基础工资”按钮,“工资”列将自动填充员工对应的工资数据,如图12-34所示。

图12-33  空表                 图12-34  填充基础工资           图12-35  基础工资表“基础工资表”工作表中的数据如图12-35所示,本例根据该工作表中的数据自动填充对应员工的工资。2.关键技术(1)Dictionary对象Dictionary对象用于在结对的名称/值中存储信息(等同于键/项目)。Dictionary对象看似比数组更为简单,然而,Dictionary对象却是更令人满意的处理关联数据的解决方案。使用Dictionary对象的属性和方法可操作具体的数据项。本例使用以下方法控制字典对象:—    Add:向Dictionary对象添加新的键/项目对。—    Exists:返回一个逻辑值,这个值可指示某个指定的键是否存在于Dictionary对象中。—    Items:返回Dictionary对象中所有项目的一个数组。(2)Transpose方法使用该方法将返回转置单元格区域,即将一行单元格区域转置成一列单元格区域,反之亦然。在行列数分别与数组的行列数相同的区域中,必须将TRANSPOSE输入为数组公式中。使用TRANSPOSE可在工作表中转置数组的垂直和水平方向。该方法的语法格式如下:表达式.Transpose(Arg1)参数Arg1是要进行转置的工作表中的单元格数组或区域。所谓数组的转置就是,将数组的第一行作为新数组的第一列,将数组的第二行作为新数组的第二列,依此类推。3.编写代码“查询基础工资”按钮的VBA代码如下:Sub 查询基础工资()Dim arr, dsDim j As Long, k As Long, i As LongApplication.ScreenUpdating = FalseSet ds = CreateObject("Scripting.Dictionary")   '创建数据字典对象With Worksheets("工资表")j = .Range("B2").End(xlDown).Row.Range("B3:B" & j) = ""               清除“工资”列中的数据k = .Range("A3").End(xlDown).Rowarr = .Range("A3:A" & k)              将“姓名”列赋值到数组中For i = 3 To k                    将每个姓名作为一个字典对象的数据项ds.Add arr(i - 2, 1), ""NextEnd WithWith Worksheets("基础工资表")j = .Range("A3").End(xlDown).Rowarr = .Range("A3:B" & j)End WithOn Error Resume NextFor i = 3 To j  '在“基础工资表”查询“姓名”,有相同的姓名,则将工资保存到字典对象中If ds.Exists(arr(i - 2, 1)) Then ds(arr(i - 2, 1)) = _ds(arr(i - 2, 1)) & arr(i - 2, 2)NextWorksheets("工资表").Range("B3").Resize(k - 2, 1) = _WorksheetFunction.Transpose(ds.Items)Set ds = NothingApplication.ScreenUpdating = TrueEnd Sub12.3  数据排序在Excel 2007中,在“开始”选项卡的“编辑”组中单击“排序和筛选”按钮,从下拉的菜单按钮中选择相应的命令即可进行排序操作。在VBE中,可使用Sort方法进行排序相关的操作,本节实例演示数据排序的VBA代码。例269  用VBA代码排序1.案例说明打开本例工作簿如图12-36所示,单击左上角的“按姓名排序”按钮,工作表中的数据按姓名升序排列,如图12-37所示。2.关键技术在Excel 2007操作环境中进行排序时,在单元格中单击作为关键字的列,选择“开始”选项卡“编辑”组中的“排序和筛选”按钮中的相关命令可对工作表中的数据进行排序。但这时参与排序的是所有数据行,在如图12-36所示工作表中的数据排序时,最后一行(“合计”)也参与排序,使数据出现不希望的排序结果。这时使用VBA代码可方便地控制排序的区域,Range对象的Sort方法可对值区域进行排序。其语法格式如下:表达式.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

图12-36  数据表

图12-37  排序后的数据该方法有很多参数,这些参数都可省略。各参数的含义如下:—    Key1:指定第一排序字段,作为区域名称(字符串)或Range对象;确定要排序的值。—    Order1:确定Key1中指定的值的排序次序,可设置为常量xlAscending(升序)或xlDescending(降序)。—    Key2:第二排序字段。—    Type:指定要排序的元素。—    Order2:确定Key2中指定的值的排序次序。—    Key3:第三排序字段。—    Order3:确定Key3中指定的值的排序次序。—    Header:指定第一行是否包含标题信息。—    OrderCustom:指定在自定义排序次序列表中的基于1的整数偏移。—    MatchCase:设置为True,则执行区分大小写的排序,设置为False,则执行不区分大小写的排序;不能用于数据透视表。—    Orientation:指定以升序还是降序排序。可用常量xlSortColumns(按列排序)或xlSortRows(按行排序,这是默认值)。—    SortMethod:指定排序方法。可用常量xlPinYin(按汉语拼音顺序排序,这是默认值)或xlStroke(按每个字符的笔画数排序)。—    DataOption1:指定Key1中所指定区域中的文本的排序方式,可使用常量xlSortNormal(分别对数字和文本数据进行排序,这是默认值)或xlSortTextAsNumbers(将文本作为数字型数据进行排序)。—    DataOption2:指定Key2中所指定区域中的文本的排序方式。—    DataOption3:指定Key3中所指定区域中的文本的排序方式。—

—   使用Sort方法排序时,最多只能按3个关键字进行排序。—3.编写代码“按姓名排序”按钮的VBA代码如下:Sub 排序()Dim rng As Range, r As Long, c As Longr = ActiveSheet.Range("A1").CurrentRegion.Rows.Countc = ActiveSheet.Range("A2").CurrentRegion.Columns.CountSet rng = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))rng.Sort key1:=ActiveSheet.Range(Cells(3, 2), Cells(r - 1, 2))End Sub以上代码首先获取当前工作表中需要排序的单元格区域,对该区域使用Sort方法按“姓名”列进行排序。例270  乱序排序1.案例说明在很多情况下,希望得到一种无序的数据排列,使用乱序排序的方法可得到这种效果,本例演示这种效果。打开本例工作簿,单击工作表左上角的“乱序排序”按钮,工资表中的数据将呈无序排列,如图12-38所示。

图12-38  乱序排序2.关键技术使用乱序排序的一种算法是:在需要排序的数据右侧生成一列随机数据,然后以该随机数的列作为关键字进行排序,即可得到乱序的效果。3.编写代码“乱序排序”按钮的VBA代码如下:Sub 乱序排序()Dim rng As Range, r As Long, c As LongRandomizeApplication.ScreenUpdating = FalseWith ActiveSheetr = .Range("A1").CurrentRegion.Rows.Countc = .Range("A2").CurrentRegion.Columns.CountFor i = 3 To r – 1     '添加随机数据.Cells(i, c + 1) = Int((Rnd * 100) + 1)NextSet rng = .Range(Cells(3, 1), Cells(r - 1, c + 1))rng.Sort key1:=.Range(Cells(3, c + 1), Cells(r - 1, c + 1)).Columns(c + 1).Clear '清除添加的随机数据End WithApplication.ScreenUpdating = TrueEnd Sub以上代码首先在需要排序的数据右列添加随机数据,再使用Sort方法按该列的数据进行排序,最后删除增加的随机数据列。例271  自定义序列排序1.案例说明打开本例工作簿,单击“自定义序列排序”按钮,工作表中的数据将按C列(部门)中的数据按自定义序列排序,如图12-39所示。自定义序列如图12-40所示,在图12-40所示工作表中更改数据的排列顺序后,再单击“自定义序列排序”按钮,C列(部门)又将按新的序列重新排列。2.关键技术本例演示用VBA代码创建自定义序列的方法,主要用AddCustomList方法添加自定义序列,用DeleteCustomList方法删除自定义序列。(1)AddCustomList方法用该方法为自定义自动填充和/或自定义排序添加自定义列表。其语法格式如下:表达式.AddCustomList(ListArray, ByRow)

图12-39  自定义序列排序                       图12-40  自定义序列参数的含义如下:—    ListArray:将源数据指定为字符串数组或Range对象。—    ByRow:仅当ListArray为Range对象时使用。如果为True,则使用区域中的每一行创建自定义列表;如果为False,则使用区域中的每一列创建自定义列表。如果省略该参数,并且区域中的行数比列数多(或者行数与列数相等),则Excel使用区域中的每一列创建自定义列表。如果省略该参数,并且区域中的列数比行数多,则Excel使用区域中的每一行创建自定义列表。—

—   如果要添加的列表已经存在,则本方法不起作用。—(2)GetCustomListNum方法使用Application对象的GetCustomListNum方法返回字符串数组的自定义序列号。其语法格式如下:表达式.GetCustomListNum(ListArray)参数ListArray为一个字符串数组。(3)DeleteCustomList方法使用Application对象的DeleteCustomList方法删除一个自定义序列。其语法格式如下:表达式.DeleteCustomList(ListNum)参数ListNum为自定义序列数字。此数字必须大于或等于5(Excel有4个不可删除的内置自定义序列)。3.编写代码“自定义序列排序”按钮的VBA代码如下:Sub 自定义序列排序()Dim rng As Range, r As Long, c As Long, n As IntegerDim rng1 As Range, arr1Application.ScreenUpdating = False'获取排序的单元格区域r = ActiveSheet.Range("A1").CurrentRegion.Rows.Countc = ActiveSheet.Range("A2").CurrentRegion.Columns.CountSet rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))'添加自定义序列With Worksheets("Sheet2")r = .Range("A1").End(xlDown).RowSet rng = .Range(.Cells(1, 1), .Cells(r, 1))End WithWith Applicationarr1 = .WorksheetFunction.Transpose(rng).AddCustomList ListArray:=arr1n = .GetCustomListNum(arr1)End With'用自定义序列排序rng1.Sort key1:=ActiveSheet.Range(Cells(3, 3), Cells(r - 1, 3)), _Order1:=xlAscending, Header:=xlGuess, OrderCustom:=n + 1Application.DeleteCustomList ListNum:=n '删除自定义序列Application.ScreenUpdating = TrueEnd Sub以上代码首先获取需要排序的单元格区域,接着将工作表Sheet 2中的数据添加到自定义序列中,再使用自定义序列进行排序,最后删除自定义序列。例272  多关键字排序1.案例说明在Excel中对数据进行排序时,最多只能使用3个关键字排序,如果3个关键字相同时,要使用4个或更多关键字排序就比较麻烦。本例演示使用4个关键字排序的方法。打开本例工作簿,单击工作表左上角的“多关键字排序”按钮,工作表中的数据将按C列到F列(共4列)的数据进行排序,得到如图12-41所示的结果。从图中可以看出,首先按C列(部门)排序,部门相同时再按D列(基础工资)排序,基础工资相同再按E列(岗位工资)排序,岗位工资相同再按F列(工龄工资)排序。如销售部两员工的基础工资、岗位工资都相同,则按工龄工资排序(陈晴工龄工资低,排在前面)。2.关键技术对于超过三个关键字的排序,本例使用的方法时,先将数据按最后一个关键字排序,接着再将数据按倒数第二个关键字排序,……,最后将数据按主要(第一个)关键字排序,即可得到所需要的排列。使用这种方法,可使用任意数量的关键字进行排序。

图12-41  多关键字排序3.编写代码“多关键字排序”按钮的VBA代码如下:Sub 多关键字排序()Dim rng1 As Range, r As Long, c As Long, i As IntegerApplication.ScreenUpdating = False'获取排序的单元格区域r = ActiveSheet.Range("A1").CurrentRegion.Rows.Countc = ActiveSheet.Range("A2").CurrentRegion.Columns.CountSet rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))With rng1For i = 6 To 3 Step -1.Sort key1:=ActiveSheet.Range("C3").Offset(, i - 3)NextEnd WithApplication.ScreenUpdating = TrueEnd Sub例273  输入数据自动排序1.案例说明打开本例工作簿,在B列中输入姓名,如图12-42所示,当按回车键或Tab键完成该列单元格的输入时,输入的数据将自动按顺序排列到工作表的相应行中,如图12-43所示。2.关键技术本例需要根据用户对单元格数据的更改及时完成排序,所以需要在工作表的Change事件过程中编写代码,有关该事件过程的应用在本书前面多个例子都在使用。另外本例还使用了Application对象的Intersect方法,该方法返回一个Range对象,该对象表示两个或多个区域重叠的矩形区域。其语法格式如下:表达式.Intersect(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)该方法最多可使用30个单元格区域作为参数,至少需使用两个参数。

图12-42  输入数据

图12-43  自动排序在本例中,使用以下表示方法判断Target和单元格区域[B3:B1000]是否有重叠,若有重叠,则表示Target包含在区域[B3:B1000]中,否则,则是在该区域之外。Application.Intersect(Target, [B3:B1000])3.编写代码要完成本例的功能,需要在工作表的Change事件过程中编写以下代码:Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column <> 2 Then Exit Sub  '修改的数据不是第2列,退出If Not Application.Intersect(Target, [B3:B1000]) Is Nothing ThenSet rng = ActiveSheet.Range("A1").CurrentRegionSet rng = rng.Offset(2, 0).Resize(rng.Rows.Count - 2, rng.Columns. Count)rng.Sort Key1:=Range("B3")End IfEnd Sub以上代码首先判断更改数据的单元格是否为第2列,接着判断更改数据单元格是否为“B3:B1000”单元格区域中的单元格,然后获取当前区域需要排序的单元格区域,使用Sort方法对这个区域进行排序即可。例274  数组排序1.案例说明打开本例工作簿如图12-44所示,单击“生成随机数”按钮,打开如图12-45所示对话框,在对话框中输入需要生成的随机数数量,单击“确定”按钮即可生成相应的随机数,如图12-46所示。

图12-44  空工作表                                图12-45  输入数量单击“排序”按钮,将生成的随机数按升序排列,如图12-47所示。

图12-46  生成随机数                                    图12-47  排序2.关键技术Excel工作表可以方便地和数组进行转换,即单元格区域可以赋值给一个数组,数组也可以通过Transpose方法填充到单元格区域中去。(1)单元格区域赋值给数组使用以下方法可将单元格区域赋值给一个数组:arr = ActiveSheet.Range("A1:A10")使用这种赋值将产生一个二维数组,即使单元格区域只选择一行(或一列),得到的也是一个二维数组。(2)数组填充单元格区域对于二维数组,可直接使用以下方法将其赋值给单元格区域:ActiveSheet.Range("A1:A" & n) = arr如果是一维数组,则需要使用Transpose方法对数组进行置换为列或列进行填充。3.编写代码(1)“生成随机数”按钮的VBA代码如下:Sub 生成随机数()Dim arr(), i As Long, n As LongRandomize Timern = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _Title:="输入数量", Default:=10, Type:=1)If n <= 0 Or r > 65536 Then Exit SubReDim arr(1 To n)                         '定义动态数组For i = 1 To n                            '循环生成随机数arr(i) = Int(Rnd * 10000)NextWith ActiveSheet.Columns(1).Clear.Range("A1:A" & n) = Application.Transpose(arr)  '数组赋值给单元格区域End WithEnd Sub(2)“排序”按钮的VBA代码如下:Sub排序()Dim arr, tDim i As Long, j As Long, n As Longn = ActiveSheet.Range("A1").End(xlDown).RowIf n <= 1 Then Exit Subarr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中For i = 1 To n - 1                        '双循环排序For j = i + 1 To nIf arr(j, 1) < arr(i, 1) Thent = arr(i, 1)                '交换数据arr(i, 1) = arr(j, 1)arr(j, 1) = tEnd IfNextNextActiveSheet.Range("A1:A" & n) = arr      '数组赋值给单元格区域End Sub例275  使用Small和Large函数排序1.案例说明打开本例工作簿,在工作表中单击“生成随机数”按钮将打开如图12-48所示的对话框,在对话框中输入产生随机数的个数,单击“确定”按钮将在工作表中的A列生成指定数量的随机数。单击“升序排序”按钮,生成的随机数将按从小到大的顺序排列,如图12-49所示。单击“降序排序”按钮,生成的随机数将按从大到小的顺序排列。

图12-48  输入随机数量                                 图12-49  升序排序2.关键技术(1)Small方法在VBA中通过WorksheetFunction对象的Small方法可调用Excel工作表函数Small。该方法将返回数据集中第k个最小值。其语法格式如下:表达式.Small(Arg1, Arg2)参数的含义如下:—    Arg1:需要确定第k个最小值的数值数据数组或区域。—    Arg2:要返回的数据在数组或区域中的位置(从最小值开始)。如果Arg1为空,则Small将返回错误值#NUM!。如果Arg2≤0或Arg2超过了数据点个数,则Small将返回错误值#NUM!。如果n为数组中数据点的个数,则Small(array,1)等于最小值,Small(array,n)等于最大值。(2)Large方法与Small方法类似,Large方法返回数据集中第k个最大值(Small方法返回第k个最小值)。例如,可以使用函数Large得到第一名、第二名或第三名的得分。3.编写代码(1)“生成随机数”按钮的VBA代码如下:Sub 生成随机数()Dim arr(), i As Long, n As LongRandomize Timern = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _Title:="输入数量", Default:=10, Type:=1)If n <= 0 Or r > 65536 Then Exit SubReDim arr(1 To n)                '定义动态数组For i = 1 To n               '循环生成随机数arr(i) = Int(Rnd * 10000)NextWith ActiveSheet.Columns(1).Clear.Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '数组赋值给单元格区域End WithEnd Sub(2)“升序排序”按钮的VBA代码如下:Sub 升序排序()Dim arr, arr1(), i As Long, n As Longn = ActiveSheet.Range("A1").End(xlDown).RowIf n <= 1 Then Exit Subarr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中ReDim arr1(1 To n)For i = 1 To n                           '选出第i个最小的数arr1(i) = WorksheetFunction.Small(arr, i)NextActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)'数组赋值给单元格区域End Sub(3)“降序排序”按钮的VBA代码如下:Sub 降序排序()Dim arr, arr1(), i As Long, n As Longn = ActiveSheet.Range("A1").End(xlDown).RowIf n <= 1 Then Exit Subarr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中ReDim arr1(1 To n)For i = 1 To n                          '选出第i个最大的数arr1(i) = WorksheetFunction.Large(arr, i)NextActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)'数组赋值给单元格区域End Sub例276  使用RANK函数排序1.案例说明打开本例工作簿,单击“生成随机数”按钮在工作表中的A列生成指定数量的随机数。单击“排序”按钮,生成的随机数将按从小到大的顺序排列,如图12-50所示。2.关键技术使用WorksheetFunction对象的Rank方法,可返回一个数字在数字列表中的排位。数字的排位是其大小与列表中其他值的比值(如果列表已排过序,则数字的排位就是它当前的位置)。Rank方法语法的语法格式如下:表达式.Rank(Arg1, Arg2, Arg3)

图12-50  排序各参数的含义如下:—    Arg1:为要查找其排位的数字。—    Arg2:数字列表数组或对数字列表的引用,为一个Range对象。—    Arg3:指定数字的排位方式的数字。如果Arg3为0(零)或被省略,Excel会按照Arg2为按降序排序的列表对数字排位。如果Arg3不为零,Excel会按照Arg2为按升序排序的列表对数字排位。—

函数RANK对重复数的排位相同。但重复数的存在将影响后续数值的排位。例如,在一列按升序排列的整数中,如果整数10出现两次,其排位为5,则11的排位为 7(没有排位为6的数值)。3.编写代码(1)“生成随机数”按钮的VBA代码如下:Sub 生成随机数()Dim arr(), i As Long, n As LongRandomize Timern = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _Title:="输入数量", Default:=10, Type:=1)If n <= 0 Or r > 65536 Then Exit SubReDim arr(1 To n)                                            '定义动态数组For i = 1 To n                                           '循环生成随机数arr(i) = Int(Rnd * 10000)NextWith ActiveSheet.Columns(1).Clear.Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '数组赋值给单元格区域End WithEnd Sub(2)“排序”按钮的VBA代码如下:Sub 排序()Dim arr, rng As Range, t As Long, i As Longn = ActiveSheet.Range("A1").End(xlDown).RowIf n <= 1 Then Exit SubReDim arr(1 To n)Set rng = ActiveSheet.Range("A1:A" & n)      '获取单元格区域引用For i = 1 To nt = WorksheetFunction.Rank(rng(i, 1), rng, 1)arr(t) = rng(i, 1)NextActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr)'数组赋值给单元格区域End Sub例277  姓名按笔画排序1.案例说明在各种会议中,对出席会议(或选举产生)的人员需要列出名单,这些名单一般是按姓名笔画排序。Excel提供了按笔画排序的方法,但用这种方法排序时也将会出现一些问题,例如:姓名为双字的,一般要在姓和名之间加上一个空格,若为女性或少数民族,还要在姓名后面用括号标明。本例编写VBA代码,对姓名按笔画排序,能自动处理姓名之间有空格、有括号的情况。打开本例工作簿如图12-51所示,单击“按姓名笔画排序”按钮,将得到如图12-52所示的排序结果。本例自动生成按笔画排序的汉字库表,如图12-53所示。该工作表根据“姓名”工作表中的汉字自动生成。

图12-51  无序姓名                  图12-52  笔画排序                图12-53  汉字库2.关键技术使用笔画对数据进行排序时,需设置排序方法Sort的SortMethod属性,该属性指定中文排序方法。可设置为以下值:—    xlPinYin:按字符的汉语拼音顺序排序。这是默认值。—    xlStroke:按每个字符的笔画数排序。本例的代码很长,其工作流程如下:(1)首先使用字典对象Dictionary保存姓名中的汉字。(2)将字典对象中的汉字填充到“汉字库”工作表的单元格区域。(3)使用Sort方法按笔画排序“汉字库”中的汉字。(4)删除字典对象中原有的数据,重新将排序后的“汉字库”工作表中的数据写入字典对象中,并为每个汉字添加顺序号。(5)读取“姓名”工作表中每个姓名,从字典对象中查询每个字的顺序号,对每个名字生成一个序列码字符串,将“姓名”和序列码字符串保存到一个二维数组中。(6)对二维数组进行排序,得到按笔画排序的姓名。(7)将排序后的数组填充到“姓名”工作表中,得到如图12-52所示的结果。3.编写代码“按笔画排序”按钮的VBA代码如下,该子过程的代码较长,可参考关键技术中介绍的工作程序理解每一部分的作用。Sub 按笔画排序()Dim ds As Scripting.Dictionary   '字典对象Dim r As Long, i As Long, j As IntegerDim c As String, xm As String, c1 As StringDim str1 As String, n As LongDim arr, arr1()Application.ScreenUpdating = FalseSet ds = CreateObject("Scripting.Dictionary")    '创建数据字典对象With Worksheets("姓名")r = .Range("A1").End(xlDown).RowOn Error Resume NextFor i = 1 To rstr1 = .Cells(i, 1).Value              '获取单元格的姓名For j = 1 To Len(str1)                 '将字符串拆分为单个汉字s = Mid(str1, j, 1)If s <> " " Thends.Add s, s                       '添加字典中If Err <> 0 Then Err.ClearEnd IfNextNextOn Error GoTo 0End Withr = ds.Count                                 '字典中的条目数量With Worksheets("汉字库").Columns(1).Clear                         '清除A列.Range("A1").Resize(r, 1) = _WorksheetFunction.Transpose(ds.Items)  '将字典中的数字填充到A列r = .Range("A1").End(xlDown).RowWith .Sort                             '对A列按笔画排序.SetRange Range("A1:A" & r).Header = xlGuess.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlStroke.ApplyEnd Witharr = .Range("A1:A" & r)End Withds.RemoveAll                                 '删除字典中的所有数据For i = 1 To r                               '把汉字添加到字典中ds.Add arr(i, 1), iNextWith Worksheets("姓名")r = .Range("A1").End(xlDown).RowReDim arr1(1 To r, 1 To 2)                 '生定义数组For i = 1 To rc = .Cells(i, 1)                       '获取单元格的值arr1(i, 1) = c                         '保存到数组中xm = Replace(Replace(Replace(c, " ", ""), " ", ""), "(", "(")'删除空格,全角括号换为半角括号xm = Left(xm, InStr(xm & "(", "(") - 1) '去掉括号及括号中的字符c1 = ""For j = 1 To Len(xm)                   '从字典中查询生成序列码字符串c1 = c1 & CStr(Format(ds(Mid(xm, j, 1)), "0000"))Nextarr1(i, 2) = c1                     '保存姓名的序列码字符串NextFor i = 1 To r – 1                     '双循环排序For j = i + 1 To rIf arr1(i, 2) > arr1(j, 2) Then      '按姓名的序列码字符串比较t1 = arr1(i, 1)                   '交换数据t2 = arr1(i, 2)arr1(i, 1) = arr1(j, 1)arr1(i, 2) = arr1(j, 2)arr1(j, 1) = t1arr1(j, 2) = t2End IfNextNext.Range("A1:A" & r) = arr1                 '将排序后的数组填充到单元格区域End WithApplication.ScreenUpdating = TrueEnd Sub12.4  数据筛选在Excel 2007中,在“开始”选项卡的“编辑”组中单击“排序和筛选”按钮,从下拉的菜单按钮中选择相应的命令即可进行数据筛选操作。在VBE中,可使用AutoFilter方法进行自动筛选操作,使用AdvancedFilter方法可进行高级筛选操作,本节实例演示数据筛选的VBA代码。例278  用VBA进行简单筛选1.案例说明打开本例工作簿如图12-54所示,单击工作表左上角的“筛选”按钮弹出如图12-55所示的对话框,在对话框中输入筛选条件“财务部”,单击“确定”按钮,工作表中将自动出现自动筛选下拉箭头,并且只显示“部门”为“财务部”的数据,如图12-56所示。在如图12-55所示的“筛选”对话框中不输入任何值,直接单击“确定”按钮即可显示全部数据。

图12-54  用VBA筛选数据

图12-55  输入筛选条件                            图12-56  筛选结果2.关键技术使用Range对象的AutoFilter方法,可对Range区域的数据中使用“自动筛选”筛选一个列表。该方法的语法如下:表达式.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)各参数的含义如下:—    Field:相对于作为筛选基准字段(从列表左侧开始,最左侧的字段为第一个字段)的字段的整型偏移量。—    Criteria1:筛选条件,为一个字符串。使用“=”可查找空字段,或者使用“<>”查找非空字段。如果省略该参数,则搜索条件为All。如果将Operator设置为xlTop10Items,则Criteria1指定数据项个数(例如,“10”)。—    Operator:指定筛选类型,可用常量如表12-2所示。表12-2  筛选类型名    称值描    述xlAnd1条件1和条件2的逻辑与xlBottom10Items4显示最低值项(条件1中指定的项数)xlBottom10Percent6显示最低值项(条件1中指定的百分数)xlFilterCellColor8单元格颜色xlFilterDynamic11动态筛选xlFilterFontColor9字体颜色xlFilterIcon10筛选图标xlFilterValues7筛选值xlOr2条件1和条件2的逻辑或xlTop10Items3显示最高值项(条件1中指定的项数)xlTop10Percent5显示最高值项(条件1中指定的百分数)—    Criteria2:第二个筛选条件(一个字符串)。与Criteria1和Operator一起组合成复合筛选条件。—    VisibleDropDown:如果为True,则显示筛选字段的自动筛选下拉箭头。如果为False,则隐藏筛选字段的自动筛选下拉箭头。默认值为True。—

—   如果忽略全部参数,此方法仅在指定区域切换自动筛选下拉箭头的显示。—3.编写代码“筛选”按钮的VBA代码如下:Sub 筛选()Dim str1 As Stringstr1 = Application.InputBox(prompt:="请输入要筛选的部门名称(空字符将显示全部数据):", _Title:="筛选", Type:=2)If str1 = "False" Then Exit SubIf str1 = "" ThenWorksheets("Sheet1").Range("A1").AutoFilter  field:=3ElseWorksheets("Sheet1").Range("A1").AutoFilter _field:=3, _Criteria1:=str1End IfEnd Sub以上代码首先要求用户输入筛选条件,接着判断用户输入的是否为空,若为空,则显示全部数据,若输入的筛选条件不为空,则筛选等于输入条件的数据。例279  用VBA进行高级筛选1.案例说明打开本例工作簿如图12-57所示,在下方的“条件区域”部分输入条件,再单击左上角的“高级筛选”按钮,即可按条件区域中输入的条件对数据进行高级筛选,得到如图12-58所示的结果。如果在条件区域删除数据(例如删除图12-57下方的“财务部”和“>=1400”),再单击“高级筛选”按钮,工作表将显示全部数据(取消高级筛选功能)。

图12-57  高级筛选

图12-58  高级筛选结果若在条件区域不同行输入条件,则将采用逻辑或关系筛选数据(即只要满足一列条件即可),如图12-59所示,可显示“人事部”或“基础工资”大于1400的数据。

图12-59  逻辑或筛选2.关键技术Excel的高级筛选可用VBA代码来实现,使用Range对象的AdvancedFilter方法即可进行高级筛选。高级筛选必须在工作表中定义一个条件区域,通过该条件从列表中筛选或复制数据。如果初始选定区域为单个单元格,则使用单元格的当前区域。AdvancedFilter方法的语法格式如下:表达式.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)该方法各参数的含义如下:—    Action:指定是否就地复制或筛选列表,可使用常量xlFilterCopy(将筛选出的数据复制到新位置)或xlFilterInPlace(保留数据不动)。—    CriteriaRange:条件区域。如果省略该参数,则没有条件限制。—    CopyToRange:如果Action为xlFilterCopy,则该参数为复制行的目标区域。否则,忽略该参数。—    Unique:如果为True,则只筛选唯一记录。如果为False,则筛选符合条件的所有记录。默认值为False。3.编写代码“高级筛选”按钮的VBA代码如下:Sub 高级筛选()Dim rng As Range, rng1 As RangeApplication.ScreenUpdating = FalseApplication.Calculation = xlCalculationManual    '手动重算Set rng = Worksheets("Sheet1").Range("A19").CurrentRegionSet rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)Set rng1 = Worksheets("Sheet1").Range("A1").CurrentRegionSet rng1=rng1.Offset(1,0).Resize(rng1.Rows.Count-1, rng1.Columns.Count)rng1.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rngApplication.Calculation = xlCalculationAutomatic '自动重算Application.ScreenUpdating = TrueEnd Sub以上代码首先获取工作表中条件区域和筛选数据区域的引用,最后使用AdvancedFilter方法对数据区域进行筛选。例280  筛选非重复值1.案例说明打开本例工作簿,单击工作表中的“生成随机数”按钮,将在工作表的A列生成1000个随机数,再单击“筛选非重复值”按钮,可将左侧生成的1000个随机数中的非重复数筛选并复制到B列中,如图12-60所示。2.关键技术本例使用Range对象的AdvancedFilter方法筛选非重复值,有关该方法的介绍参见上例中的内容。

图12-60  筛选非重复值3.编写代码(1)“生成随机数”按钮的VBA代码如下:Sub 生成随机数()Dim i As IntegerApplication.ScreenUpdating = FalseRandomizeWith ActiveSheetFor i = 2 To 1001.Cells(i, 1) = Int(Rnd * 1000 + 1)NextEnd WithApplication.ScreenUpdating = TrueEnd Sub(2)“筛选非重复值”按钮的VBA代码如下:Sub 筛选非重复值()Dim i As Long, rng As RangeApplication.ScreenUpdating = FalseWith ActiveSheeti = .Range("A1").End(xlDown).RowIf i > 1001 Then Exit SubSet rng = .Range(Cells(2, 1), Cells(i, 1)).Columns("B").ClearContentsrng.AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=.Range("B2"), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd Sub例281  取消筛选1.案例说明打开本例工作簿如图12-61所示,在如图所示工作表中设置了自动筛选,单击“取消筛选”按钮,当前工作簿中每个工作表中的自动筛选都将取消,如图12-62所示。2.关键技术如果当前在工作表上显示有“自动筛选”下拉箭头,则AutoFilterMode属性值为True。设置该属性值为False可取消自动筛选状态。

图12-61  筛选状态的工作表

图12-62  取消筛选的工作表—

—   不能将该属性设置为True。使用AutoFilter方法可筛选列表并显示下拉箭头。—3.编写代码“取消筛选”按钮的VBA代码如下:Sub 取消筛选()Dim ws1 As WorksheetFor Each ws1 In Worksheetsws1.AutoFilterMode = FalseNextEnd Sub

(0)

相关推荐