首页 43个典型ExcelVBA实例

43个典型ExcelVBA实例

举报
开通vip

43个典型ExcelVBA实例43个典型ExcelVBA实例 目录 3例1.九九乘法表(Print方法的应用) 3例2  输入个人信息(Inputbox函数的应用) 5例3  退出确认(Msgbox函数的应用) 7例4 突出显示不及格学生 8例5  从身份证号码中提取性别 9例6  评定成绩等级 11例7  计算个人所得税 13例8  密码验证 15例9  求最小公倍数和最大公约数 16例10  输出ASCII码表 17例11  计算选中区域数值之和 18例12  换零钱法(多重循环) 21例13...

43个典型ExcelVBA实例
43个典型ExcelVBA实例 目录 3例1.九九乘法表(Print 方法 快递客服问题件处理详细方法山木方法pdf计算方法pdf华与华方法下载八字理论方法下载 的应用) 3例2  输入个人信息(Inputbox函数的应用) 5例3  退出确认(Msgbox函数的应用) 7例4 突出显示不及格学生 8例5  从身份证号码中提取性别 9例6  评定成绩等级 11例7  计算个人所得税 13例8  密码验证 15例9  求最小公倍数和最大公约数 16例10  输出ASCII码表 17例11  计算选中区域数值之和 18例12  换零钱法(多重循环) 21例13  数据排序 22例14  彩票幸运号码 24例15  用数组填充单元格区域 25例16 判断单元格是否包含公式 26例17 自动填充公式 28例18 锁定和隐藏公式 29例19 将单元格公式转换为数值 29例20  删除所有公式 30例21  用VBA表示数组公式 31数据查询 31例22  查找指定的值 33例23  带 格式 pdf格式笔记格式下载页码格式下载公文格式下载简报格式下载 查找 34例24 查找上一个/下一个数据 36例25 代码转换 37例26  模糊查询 38例27  网上查询快件信息 40例28  查询基金信息 41例29  查询手机所在地 43例30  使用字典查询 45数据排序 45例31  用VBA代码排序 46例32  乱序排序 47例33  自定义序列排序 49例34  多关键字排序 50例35  输入数据自动排序 51例36 数组排序 52例37 使用Small和Large函数排序 54例38 使用RANK函数排序 56例39  姓名按笔画排序 59例40  用VBA进行简单筛选 61例41  用VBA进行高级筛选 62例42 筛选非重复值 63例43  取消筛选 : 例1.九九乘法表(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 9         For j = 1 To i             Debug.Print i; "x"; j; "="; i * j; "  ";         Next         Debug.Print                                           Next End Sub (3)按功能键“F5”运行子过程,在“立即窗口”输出九九乘法表,如图3-1所示。 例2  输入个人信息(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 "姓名:"; strName     Debug.Print "年龄:"; age     Debug.Print "地址:"; Address End Sub (3)按功能键“F5”运行子过程,将弹出“输入个人信息”窗口。在对话框中输入内容后按“回车”,或单击“确定”按钮。 (4)接着输入“年龄”和“地址”信息,在“立即窗口”中将输出这些内容。 例3  退出确认(Msgbox函数的应用) 1.案例说明 在应用程序中,有时用户会由于误操作关闭Excel,为了防止这种情况,可在退出Excel之前弹出对话框,让用户确认是否真的要关闭Excel。 本例使用Msgbox函数弹出对话框,让用户选择是否退出系统。 2.关键技术 使用MsgBox函数可打开一个对话框,在对话框中显示一个提示信息,并让用户单击对话框中的按钮,使程序继续执行。 MsgBox函数语法格式如下: Value=MsgBox(prompt[,buttons][,title][ ,helpfile,context]) 通过函数返回值可获得用户单击的按钮,并可根据按钮的不同而选择不同的程序段来执行。 该函数共有5个参数,除第1个参数外,其余参数都可省略。各参数的意义与Inputbox函数参数的意义基本相同,不同的地方是多了一个buttons参数,用来指定显示按钮的数目及形式、使用提示图标样式、默认按钮以及消息框的强制响应等。其常数值如表3-1所示。 表3-1  按钮常数值 常    量 值 说    明 vbOkOnly 0 只显示“确定”(Ok)按钮 vbOkCancel 1 显示“确定”(Ok)及“取消”(Cancel)按钮 vbAbortRetryIgnore 2 显示“异常终止”(Abort)、“重试”(Retry)及“忽略”(Ignore)按钮 vbYesNoCancel 3 显示“是”(Yes)、“否”(No)及“取消”(Cancel)按钮 续表  常    量 值 说    明 vbYesNo 4 显示“是”(Yes)及“否”(No)按钮 vbRetryCancel 5 显示“重试”(Retry)及“取消”(Cancel)按钮 vbCritical 16 显示Critical Message图标 vbQuestion 32 显示Warning Query图标 vbExclamation 48 显示Warning Message图标 vbInformation 64 显示Information Message图标 vbDefaultButton1 0 以第一个按钮为默认按钮 vbDefaultButton2 256 以第二个按钮为默认按钮 vbDefaultButton3 512 以第三个按钮为默认按钮 vbDefaultButton4 768 以第四个按钮为默认按钮 vbApplicationModal 0 进入该消息框,当前应用程序暂停 vbSystemModal 4096 进入该消息框,所有应用程序暂停 表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所示。代码窗口中将自动生成事件过程结构如下:   Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub (4)在上面生成的事件过程中输入以下代码: Private Sub Workbook_BeforeClose(Cancel As Boolean)     Dim intReturn As Integer     intReturn = MsgBox("真的退出系统吗?", vbYesNo + vbQuestion, "提示")     If intReturn <> vbYes Then Cancel = True End Sub (5)保存Excel工作簿。 (6)关闭Excel工作簿。 分支结构,又叫选择结构。这种结构的程序将根据给定的条件来决定执行哪一部分代码,而跳过其他代码。 例4 突出显示不及格学生 1.案例说明 本例判断学生成绩表中的成绩,如果成绩不及格(低于60分),则将该成绩着重显示出来。 2.关键技术 在本例中,需要进行一个判断(成绩是否低于60分),这时可使用If…Then语句。用If…Then语句可有条件地执行一个或多个语句。其语法格式如下: If 逻辑表达式 Then    语句1    语句1    … …    语句n End 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 Integer     For i = 3 To 11         If Sheets(1).Cells(i, 2).Value < 60 Then             Sheets(1).Cells(i, 2).Select             Selection.Font.FontStyle = "加粗"             Selection.Font.ColorIndex = 3         End If     Next End Sub (4)关闭VBE开发环境返回Excel。 (5)在功能区“开发工具”选项卡的“控件”组中,单击“插入”按钮弹出“表单控件”面板。 (6)在“表单控件”面板中单击“按钮”,拖动鼠标在工作表中绘制一个按钮。当松开鼠标时,将弹出“指定宏”对话框。 (7)在“指定宏”对话框中,单击选中“显示不及格学生”宏,单击“确定”按钮。 (8)右击工作表中的按钮,弹出快捷菜单如图3-12所示,单击“编辑文字”菜单,修改按钮中的提示文字为“显示不及格学生”。 (9)单击“显示不及格学生”按钮,执行宏代码,成绩表中不及格成绩将突出显示为粗体、红色。 例5  从身份证号码中提取性别 1.案例说明 在很多信息系统中都需要使用到身份证号码,身份证号码中包含有很多信息,如可从其中提取性别。我国现行使用的身份证号码有两种编码规则,即15位居民身份证和18位居民身份证。 15位的身份证号的编码规则。 dddddd yymmdd xx p 18位的身份证号的编码规则。 dddddd yyyymmdd xx p y 其中: —    dddddd为地址码(省地县三级)18位中的和15位中的不完全相同。 —    yyyymmdd yymmdd 为出生年月日。 —    xx序号类编码。 —    p性别。 —    18位中末尾的y为校验码。 2.关键技术 在If…Then语句中,条件不成立时不执行任何语句。在很多时候需要根据条件是否成立分别执行两段不同的代码,这时可用If…Then…Else语句,其语法格式如下: If 逻辑表达式 Then    语句序列1 Else    语句序列2 End 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 Sub     End If     If i = 15 Then                           '长度为15位         s = Right(sid, 1)                     '取最右侧的数字     Else                                     '长度为18度         s = Mid(sid, 17, 1)                   '取倒数第2位数     End If     If Int(s / 2) = s / 2 Then               '为偶数         sex = "女"     Else         sex = "男"     End If     MsgBox "性别:" + sex End Sub (3)切换到Excel环境,添加一个按钮“从身份证号码提取性别”,并指定执行上步创建的宏。 (4)单击“从身份证号码提取性别”按钮。 (5)输入身份证号码后单击“确定”按钮。 例6  评定成绩等级 1.案例说明 本例将成绩表中的百分制成绩按一定规则划分为A、B、C、D、E五个等级。 其中各等级对应的成绩分别为: —    A:大于等于90分; —    B:大于等于80分,小于90分; —    C:大于等于70分,小于80分; —    D:大于等于60分,小于70分; —    E:小于60分。 2.关键技术 本例共有五个分支,使用If…Then…Else这种二路分支结构也可完成,但需要复杂的嵌套结构才能解决该问题。其实VBA中提供了一种If…Then…ElseIf的多分支结构,其语法格式如下: If 逻辑表达式1 Then    语句序列1 ElseIf 逻辑表达式2 Then    语句序列2. ElseIf 逻辑表达式3 Then    语句序列3     ... … Else    语句序列n End If 在以上结构中,可以包括任意数量的ElseIf子句和条件,ElseIf子句总是出现在Else子句之前。 VBA首先判断“逻辑表达式1”的值。如果它为False,再判断“逻辑表达式2”的值,依此类推,当找到一个为True的条件,就会执行相应的语句块,然后执行End If后面的代码。如果所有“逻辑表达式”都为False,且包含Else语句块,则执行Else语句块。 3.编写代码 (1)在Excel中打开成绩表。 (2)按快捷键“Alt+F11”进入VBE开发环境。 (3)单击“插入/模块”命令向工程中插入一个模块,并编写以下VBA代码: Sub 评定等级()     Dim i As Integer     For i = 3 To 11         t = Sheets(1).Cells(i, 2).Value   '取得成绩         If t >= 90 Then             j = "A"         ElseIf t >= 80 Then             j = "B"         ElseIf t >= 70 Then             j = "C"         ElseIf t >= 60 Then             j = "D"         Else             j = "E"         End If         Sheets(1).Cells(i, 3) = j     Next End Sub (4)返回Excel操作界面,在成绩表旁边增加一个按钮,并指定执行宏“评定等级”。 (5)单击“评定等级”按钮,即可在成绩表的C列显示出各成绩对应的等级,如图3-17所示。 例7  计算个人所得税 1.案例说明 在工资管理系统中,需要计算员工应缴纳的个人所得税。个人所得税税额按5%至45%的九级超额累进税率计算应缴税额。 个人所得税的计算公式为: 应纳个人所得税税额=应纳税所得额×适用税率-速算扣除数 本例根据工资表中的相应数据计算出纳税额,并填充在工资表对应的列中。 2.关键技术 本例中计算个人所得税时共有九个分支。这时可在If…Then…ElseIf结构中添加多个ElseIf块来进行各分支的处理。对于多分支结构,可使用Select Case语句。Select Case语句的功能与If…Then…Else语句类似,但在多分支结构中,使用Select Case语句可使代码简洁易读。 Select Case结构的语法格式如下: Select Case 测试表达式 Case 表达式列表1    语句序列1 Case 表达式列表2    语句序列2     …   … Case Else    语句序列n End Select 在以上结构中,首先计算出“测试表达式”的值,然后,VBA将表达式的值与结构中的每个Case的值进行比较。如果相等,就执行与该Case语句下面的语句块,执行完毕再跳转到End Select语句后执行。其流程图如图3-20所示。 在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 Currency     curP = curP – 1600   '1600为扣除数     If curP > 0 Then         Select Case curP             Case Is <= 500                 curT = curP * 0.05             Case Is <= 2000                 curT = (curP - 500) * 0.1 + 25             Case Is <= 5000                 curT = (curP - 2000) * 0.15 + 125             Case Is <= 20000                 curT = (curP - 5000) * 0.2 + 375             Case Is <= 40000                 curT = (curP - 20000) * 0.25 + 1375             Case Is < 60000                 curT = (curP - 40000) * 0.3 + 3375             Case Is < 80000                 curT = (curP - 60000) * 0.35 + 6375             Case Is < 100000                 curT = (curP - 80000) * 0.4 + 10375             Case Else                 curT = (curP - 100000) * 0.45 + 15375         End Select         个人所得税 = curT     Else         个人所得税 = 0     End If End Function (5)在模块中编写“计算”子过程,计算工资表中每个员工应缴所得税额,并填写在对应的列中。 Sub 计算()     For i = 4 To 9         Sheets(1).Cells(i, 8).Value = 个人所得税(Sheets(1).Cells(i, 6).Value)     Next End Sub (6)返回到Excel环境中,在工资表下方插入一个按钮,为按钮指定宏为“计算”。 (7)单击“计算”按钮,可计算出每个员工的所得税额。 在实际开发的应用系统中,经常需要重复执行一条或多条语句。这种结构称为循环结构。循环结构的思想是利用计算机高速处理运算的特性,重复执行某一部分代码,以完成大量有规则的重复性运算。 VBA提供了多个循环结构控制语句:Do…Loop结构、While…Wend结构、For…Next结构、For Each…Next结构。 例8  密码验证 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所示。   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             '输入密码的次数     Do         strPassword = InputBox("请输入密码") '输入密码         If strPassword = "test" Then  '判断密码是否正确             Exit Do                '退出循环         Else             MsgBox ("请输入正确的密码!")         End If         i = i + 1     Loop While i < 3     If i >= 3 Then   '超过正常输入密码次数         MsgBox "非法用户,系统将退出!"         Application.Quit     Else         MsgBox "欢迎你使用本系统!"     End If End Sub (4)返回Excel操作界面,在工作表中插入一个按钮,设置提示文字为“密码验证”,并为该按钮指定执行的宏为“login”。 (5)单击“密码验证”按钮,弹出对话框,输入密码后单击“确定”按钮进行密码的验证。 例9  求最小公倍数和最大公约数 1.案例说明 几个数公有的倍数叫做这几个数的公倍数,其中最小的一个叫做这几个数的最小公倍数。如12、18、20这三个数的最小公倍数为180。 最大公约数是指某几个整数的共有公约数中最大的那个数。如2、4、6这三个数的最大公约数为2。 本例使用辗转相除法求两个自然数m、n的最大公约数和最小公倍数。 2.关键技术 本例首先求出两数m、n的最大公约数,再将m、n数的乘积除以最大公约数,即可得到最小公倍数。 本例使用Do…Loop循环,并且没有设置循环条件。一般情况下,这种循环是一个死循环(也就是说程序将一直循环下去),因此,在这种循环结构中必须添加一个判断语句,当达到指定的条件时退出循环。如本例中使用以下语句退出循环: If r = 0 Then Exit Do 3.编写代码 (1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。 (2)单击菜单“插入/模块”命令向工程中插入一个模块。 (3)在模块中编写以下子过程: Sub 最小公倍数和最大公约数()     Dim m As Integer, n As Integer     Dim m1 As Integer, n1 As Integer     Dim t As Integer     m = InputBox("输入自然数m:")     n = InputBox("输入自然数n:")     m1 = m     n1 = n     If m1 < n1 Then         m1 = n         n1 = m '交换m和n的值     End If     Do         r = m1 Mod n1         If r = 0 Then Exit Do         m1 = n1         n1 = r     Loop     str1 = m & "," & n & "的最大公约数=" & n1 & vbCrLf     str1 = str1 & "最小公倍数=" & m * n / n1     MsgBox str1 End Sub (4)返回Excel操作环境,向工作表中插入一个按钮,为按钮指定执行上步创建的宏。 (5)单击按钮,弹出输入提示框,分别输入两个数后,得到结果。                         例10  输出ASCII码表 1.案例说明 目前计算机中用得最广泛的字符集及其编码,是由美国国家标准局(ANSI)制定的ASCII码。ASCII码由8位二进制组成,一共可包含256个符号。本例使用循环语句输出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.编写代码 (1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。 (2)单击菜单“插入/模块”命令向工程中插入一个模块。 (3)在模块中编写以下子过程: Sub ascii()     Dim a As Integer, i As Integer     i = 3     For a = 32 To 126         Sheets(1).Cells(i, 1) = a         Sheets(1).Cells(i, 2) = Chr(a)         i = i + 1     Next End Sub (4)返回Excel操作环境,向工作表中插入一个按钮,为按钮指定执行上步创建的宏。 (5)单击按钮,得到结果。 例11  计算选中区域数值之和 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 r     Dim t As Long     For Each r In Selection         If IsNumeric(r.Value) Then             t = t + r.Value         End If     Next     MsgBox "所选区域数值之和为:" & t End Sub (4)返回Excel操作环境,向工作表中插入一个按钮,修改按钮的提示字符为“求和”,为按钮指定执行上步创建的宏“求和”。 (5)在工作表“Sheet1”中输入数据。 (6)拖动鼠标选中数据区域,单击“求和”按钮,求和结果将显示在话框中。 例12  换零钱法(多重循环) 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.编写代码 (1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。 (2)单击菜单“插入/模块”命令向工程中插入一个模块。 (3)零钱换法最简单的算法是:使用多重循环,将10元钱能换成的各种可能都考虑进去(如10可换为100个1角,可换为50个2角,等等)。根据这种算法在模块中编写以下子过程: Sub 换零钱1()     Dim t As Integer     For 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 Then                                 t = t + 1                                 Sheets(1).Cells(t + 1, 1) = i                                 Sheets(1).Cells(t + 1, 2) = j                                 Sheets(1).Cells(t + 1, 3) = k                                 Sheets(1).Cells(t + 1, 4) = l                                 Sheets(1).Cells(t + 1, 5) = m                                 Sheets(1).Cells(t + 1, 6) = n                             End If                         Next                     Next                 Next             Next         Next     Next     MsgBox "10元换为零钱共有" & t & "种方法!" End Sub (4)运行该子过程,Excel工作表中每一行将填写一种可能的换法,如图3-31所示。 (5)因为换零钱的方法很多,根据计算机的速度不同该程序的运行速度也不同,最后将通过对话框显示出总的换法次数。 (6)在循环嵌套中,内层循环体执行的次数等各外层循环数数之积,如本例代码内循环执行次数为: 101×51×21×11×6×3=21417858次 (7)对于嵌套循环,一般都可以对代码进行一定的优化,使程序的执行效率更高。本例最简单的优化代码如下: Sub 换零钱2()     Dim t As Long     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元                         t2 = 2 * j + 5 * k + 10 * l + 20 * m + 50 * n                         If t2 <= 100 Then                             t = t + 1                             i = 100 - t2                             Sheets(1).Cells(t + 1, 1) = i                             Sheets(1).Cells(t + 1, 2) = j                             Sheets(1).Cells(t + 1, 3) = k                             Sheets(1).Cells(t + 1, 4) = l                             Sheets(1).Cells(t + 1, 5) = m                             Sheets(1).Cells(t + 1, 6) = n                         End If                     Next                 Next             Next         Next     Next     MsgBox "10元换为零钱共有" & t & "种方法!" End Sub (8)以上程序中内循环的执行数数如下: 51×21×11×6×3=212058次 可以看出减少最外层循环的101次,可使用内循环体提高100倍的执行效率。 本例程序还有很多优化方法,这里就不再介绍。 使用数组 在程序中,如果要处理大量的数据,为每个数据定义一个变量将使程序变得很难阅读,并且代码很烦琐。 对于大量有序的数据,可以使用数组对其进行存储和处理。在其他程序设计语言中,数组中的所有元素都必须为同样的数据类型,在VBA中,数组中各元素可以是相同的数据类型,也可以是不同的数据类型。 例13  数据排序 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 1 Sub 数据排序()     Dim i As Integer, j As Integer     Dim k     Dim s(10) As Integer     For i = 1 To 10         s(i) = Application.InputBox("输入第" & i & "个数据:", "输入数组", , , , , , 1)     Next     For i = 1 To 9         For j = i + 1 To 10             If s(i) < s(j) Then                 t = s(i)                 s(i) = s(j)                 s(j) = t             End If         Next     Next     For Each k In s         Debug.Print k     Next End Sub 在VBA中使用Inputbox函数接受用户输入数据时,返回的值为文本型。以上代码中使用了Application对象的InputBox方法来接受用户输入数据,该方法的语法格式如下: Application.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, Type) 设置Type参数可指定返回的数据类型,如本例设置其值为2,则返回的值为数值型。 (4)运行上面的宏,弹出话框,提示用户输入数据。循环程序要求用户输入10个数据。 (5)最后在“立即窗口”输出排序的结果。 例14  彩票幸运号码 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 1 Sub 幸运号码()     Dim n As Integer, i As Integer, j As Integer     Dim l() As Integer     n = Application.InputBox("请输入需要产生幸运号码的数量:", "幸运号码", , , , , , 2)     ReDim l(n, 7) As Integer     For i = 1 To n         For j = 1 To 7             Randomize             l(i, j) = Int(10 * Rnd)         Next     Next     For i = 1 To n         For j = 1 To 7             Debug.Print l(i, j);         Next         Debug.Print     Next End Sub (4)运行上面的宏,弹出如图3-35所示的对话框,提示用户输入数据。输入生成幸运号码的数量。 (5)单击“确定”按钮后在“立即窗口”输出生成的幸运号码。 例15  用数组填充单元格区域 1.案例说明 在Excel中要处理大量数据时,可使用循环从各单元格读入数据,经过加工处理后再写回单元格区域中。这种方式比在数组中处理数据的速度要慢。因此,如果有大量的数据需要处理时,可先将数据保存到数组中,经过加工处理后,再将数组的数据填充到单元格区域。 本例演示将二维数组中的数据填充到工作表中的方法。 2.关键技术 在Excel工作表中,工作表是一个二维结构,由行和列组成。这种特性与二维数组类似,因此可以很方便地将工作表单元格区域与二维数组之间进行转换。通过以下语句可将单元格区域赋值给一个二维数组: myarr = Range(Cells(1, 1), Cells(5, 5)) 反过来,也可将二维数组中的值快速的赋值给一个单元格区域,如以下语句将二维数组myarr中的值赋值给单元格区域Rng: Rng.Value = arr 3.编写代码 (1)新建Excel工作簿,按快捷键“Alt+F11”进入VBE环境。 (2)单击菜单“插入/模块”命令向工程中插入一个模块。 (3)在模块中编写以下代码: Option Base 1 Sub 数组填充单元格区域()     Dim i As Long, j As Long     Dim col As Long, row As Long     Dim arr() As Long     row = Application.InputBox(prompt:="输入行数:", Type:=2)     col = Application.InputBox(prompt:="输入列数:", Type:=2)     ReDim arr(row, col)     For i = 1 To row         For j = 1 To col             arr(i, j) = (i - 1) * col + j         Next     Next     Set Rng = Sheets(1).Range(Cells(1, 1), Cells(row, col))     Rng.Value = arr End Sub (4)返回Excel操作环境,向工作表中添加一个按钮,设置提示文字为“填充数据”,指定该按钮的宏为“数组填充单元格区域”。 (5)单击“填充数据”按钮,弹出对话框,分别输入数组的行和列。   输入行和列 (6)VBA代码生成一个二维数组,最后填充到工作表中。 通过Excel相关对象可对工作表中的数据进行操作,如处理单元格区域的公式、对数据进行查询、排序、筛选等操作。本章演示使用VBA进行处理数据的实例。 处理公式 使用VBA代码可对工作表中的公式单元格进行处理,如判断单元格是否包含公式、复制公式、将单元格公式转换为具体的值等。 例16 判断单元格是否包含公式 1.案例说明 打开本例工作簿,单击左上角的“公式单元格”按钮,将弹出提示框,显示当前工作表中定义了公式的单元格。 显示有公式的单元格 2.关键技术 本例使用Range对象的HasFormula属性来判断指定单元格是否包含公式,如果区域中所有单元格均包含公式,则该属性值为True;如果所有单元格均不包含公式,则该属性值为False;其他情况下为null。 本例对当前单元格区域中的单元格逐个进行判断,并显示出具有公式的单元格。 3.编写代码 “公式单元格”按钮的VBA代码如下: Sub 显示公式单元格()     Dim rng As Range     Set rng = ActiveSheet.Range("A1").CurrentRegion     For Each c In rng.Cells         If c.HasFormula Then             MsgBox "单元格" & c.Address & " 定义了公式!"         End If     Next End Sub 例17 自动填充公式 1.案例说明 打开本例工作簿如图12-2所示,在如图所示工作表中,单元格J3和D16定义了公式,单击“填充公式”按钮,单元格J3的公式将向下填充,单元格D16的公式向右填充。 2.关键技术 本例使用Range对象的AutoFill方法,对指定区域中的单元格执行自动填充。该方法的语法格式如下: 表达式.AutoFill(Destination, Type) 该方法有两个参数,其含义如下: —    Destination:要填充的单元格。目标区域必须包括源区域。 —    Type:指定填充类型。该填充类型可使用xlAutoFillType枚举类型,其值如表12-1所示。 xlAutoFillType枚举值 名    称 值 描    述 xlFillCopy 1 将源区域的值和格式复制到目标区域,如有必要可重复执行 xlFillDays 5 将星期中每天的名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行 xlFillDefault 0 Excel确定用于填充目标区域的值和格式 xlFillFormats 3 只将源区域的格式复制到目标区域,如有必要可重复执行 xlFillMonths 7 将月名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行 xlFillSeries 2 将源区域中的值扩展到目标区域中,形式为系列(如,“1, 2”扩展为“3, 4, 5”)。格式从源区域复制到目标区域,如有必要可重复执行 xlFillValues 4 只将源区域的值复制到目标区域,如有必要可重复执行 xlFillWeekdays 6 将工作周每天的名称从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行 xlFillYears 8 将年从源区域扩展到目标区域中。格式从源区域复制到目标区域,如有必要可重复执行 xlGrowthTrend 10 将数值从源区域扩展到目标区域中,假定源区域的数字之间是乘法关系(如,“1, 2,”扩展为“4, 8, 16”,假定每个数字都是前一个数字乘以某个值的结果)。格式从源区域复制到目标区域,如有必要可重复执行 xlLinearTrend 9 将数值从源区域扩展到目标区域中,假定数字之间是加法关系(如,“1, 2,”扩展为“3, 4, 5”,假定每个数字都是前一个数字加上某个值的结果)。格式从源区域复制到目标区域,如有必要可重复执行 3.编写代码 “填充公式”按钮的VBA代码如下: Sub 填充公式()     Dim i As Long, j As Long     With Range("A1").CurrentRegion         i = .Rows.Count - 1         j = .Columns.Count - 1     End With         Range("J3").AutoFill _         Destination:=Range(Cells(3, 10), Cells(i, 10))     Range("D16").AutoFill _         Destination:=Range(Cells(16, 4), Cells(16, j)) End Sub 以上代码首先获取当前区域的行和列,接着使用AutoFill方法在垂直方向和水平方向填充相应的公式。 例18 锁定和隐藏公式 1.案例说明 打开本例工作簿,单击“锁定隐藏公式”按钮,当前工作表中的所有公式单元格将被锁定,不允许用户修改,而其他单元格的数据用户可进行修改。同时,公式单元格定义的公式将被隐藏,单击选取具有公式的单元格时,将不会显示公式。 图12-4  锁定和隐藏公式 2.关键技术 要锁定和隐藏单元格,可通过Range对象的以下两个属性来进行设置。 —    Locked属性:指明对象是否已被锁定。 —    FormulaHidden属性:指明在工作表处于保护状态时是否隐藏公式。 当设置以上两个属性为True时,对指定区域锁定和隐藏。但要真正锁定和隐藏单元格,必须使用Protect方法对工作表进行保护。 3.编写代码 “锁定隐藏公式”按钮的VBA代码如下: Sub 锁定和隐藏公式()     If ActiveSheet.ProtectContents = True Then         MsgBox "工作表已保护!"         Exit Sub     End If        Worksheets("Sheet1").Range("A1").CurrentRegion.Select     Selection.Locked = False     Selection.FormulaHidden = False        Selection.SpecialCells(xlCellTypeFormulas).Select     Selection.Locked = True     Selection.FormulaHidden = True        Worksheets("Sheet1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True     Worksheets("Sheet1").EnableSelection = xlNoRestrictions End Sub 例19 将单元格公式转换为数值 1.案例说明 打开本例工作簿,在当前工作表中单元格区域“J3:J15”和“D16:I15”中都定义了公式,单击选择这两个区域中的任意一个单元格,编辑栏中将显示该单元格的公式。 单击工作表左上角的“公式转为数值”按钮,当前工作表中所有公式单元格的公式定义都将被具体计算值所替代,这时再修改引用单元格的值,这两个区域的值不会再变化了。 2.关键技术 将单元格公式转换为计算结果的表示方法很简单,只需通过以下的赋值运算即可: rng.Value = rng.Value 以上赋值语句中,rng表示Range对象,该语句首先通过右侧的表达式rng.Value获取指定单元格的值(如果是公式,则获取公式的计算结果),再将该值赋值给单元格的Value变量,从而取代单元格原有的内容(公式)。 3.编写代码 “公式转为数值”按钮的VBA代码如下: Sub 公式转为数值()     Dim rng As Range, c As Range         Set rng = ActiveSheet.Range("A1").CurrentRegion     For Each c In rng.Cells         If c.HasFormula Then             c.Value = c.Value         End If     Next End Sub 以上代码首先获取工作表的当前区域,再逐个单元格判断,如果单元格有公式,则进行转换。 例20  删除所有公式 1.案例说明 在Excel中,当单元格的数据发生改变后,引用该单元格的公式单元格的值也会随之变化。有时希望经过计算后,具有公式的单元格的值不再随着引用单元格而变化。这时可以删除工作表中的公式,取消与引用单元格的关联。 打开本例工作簿,在如图所示的工作表中部分单元格具有公式,单击选择单元格I16,在编辑栏中可看到具体的公式。 具有公式的工作表 单击“删除所有公式”按钮,将打开对话框,询问用户是否删除提示工作簿中的所有公式,单击“是”按钮工作簿中各工作表中的公式都将被删除,选中单元格I16,编辑栏中可以看到显示的是具体的值,公式已被删除。  确认操作 删除公式的工作表 2.关键技术 本例代码与上例类似,不同的是本例将对所有打开工作簿进行处理,对每个工作簿的每张工作表进行循环,将具有公式的单元格转换为具体的数值。 3.编写代码 “删除所有公式”按钮的VBA代码如下: Sub 删除所有公式()     Dim wb1 As Workbook, ws1 As Worksheet     Dim rng As Range, rng1 As Range         For Each wb1 In Workbooks         With wb1             If MsgBox("是否删除工作簿“" & wb1.Name & "”中的所有公式?", _                 vbQuestion + vbYesNo) = vbYes Then                 For Each ws1 In .Worksheets                     On Error Resume Next                     Set rng1 = ws1.UsedRange.SpecialCells(xlCellTypeFormulas)     '获取公式单元格区域引用                     For Each rng In rng1                         rng.Value = rng.Value  '将公式转换成数值                     Next                 Next             End If         End With     Next End Sub 例21  用VBA表示数组公式 1.案例说明 打开本例工作簿。在Excel中,可以通过定义数组公式计算销售总金额。但是如果销售日报表中销售商品的数量不确定(占用表格的行是动态的),使用固定的数组公式就不太方便。 销售日报表 本例使用VBA动态定义数组公式,在工作表中输入数据,然后单击“汇总金额”按钮,在单元格F5中将根据录入数据的行数自动生成数组公式,在编辑栏可看到数组公式为: {=SUM(B4:B9*C4:C9)} 2.关键技术 使用Range对象的FormulaArray属性,可获取或设置区域的数组公式。如果指定区域不包含数组公式,则该属性返回null。 生成数组公式 3.编写代码 “汇总金额”按钮的VBA代码如下: Sub 汇总金额()     Dim r As Long         r = ActiveSheet.Range("A3").End(xlDown).Row        Range("F5").FormulaArray = "=SUM(B4:B" & r & "*C4:C" & r & ")" End Sub       数据查询 在Excel中,数据查询是最常用的操作。在“开始”选项卡的“编辑”组中单击“查找和选择”按钮,从下拉的菜单按钮中选择相应的命令即可进行查询操作。在VBE中,可使用Find方法进行查询相关的操作,本节实例演示查询数据的VBA代码。 例22  查找指定的值 1.案例说明 打开本例工作簿,单击左上角的“查找”按钮,弹出“查找”对话框,在该对话框中输入要查找的值(如本例中输入200),单击“确定”按钮,查找的结果显示在对话框中,同时工作表中对应单元格也加亮显示。 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 String     Dim c As Range     result = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)     If result = "False" Or result = "" Then Exit Sub     Application.ScreenUpdating = False     Application.DisplayAlerts = False     With ActiveSheet.Cells         Set c = .Find(result, , , xlWhole, xlByColumns, xlNext, False)         If Not c Is Nothing Then             str1 = c.Address             Do                 c.Interior.ColorIndex = 4 '加亮显示                 str2 = str2 & c.Address & vbCrLf                 Set c = .FindNext(c)             Loop While Not c Is Nothing And c.Address <> str1         End If     End With     MsgBox "查找到指定数据在以下单元格中:" & vbCrLf & vbCrLf _         & str2, vbInformation + vbOKOnly, "查找结果"     Application.ScreenUpdating = True     Application.DisplayAlerts = True End Sub 以上代码首先让用户输入查找的值,接着使用Find方法查找第一个满足条件的单元格,再使用循环查找当前工作簿中下一个满足条件的单元格,并在循环中对满足条件的单元格设置不同的底纹,以突出显示。 例23  带格式查找 1.案例说明 打开本例工作簿,单击左上角的“查找指定格式”按钮,单元格A2将被选中,并填上不同的底色。 2.关键技术 本例使用Application对象的FindFormat属性,设置要查找的单元格格式类型的搜索条件,然后使用Find方法按格式进行查找。 3.编写代码 “查找指定格式”按钮的VBA代码如下: Sub 查找指定格式()     With Application.FindFormat.Font         .Name = "宋体"         .FontStyle = "Bold"         .Size = 11     End With     Cells.Find(what:="", SearchFormat:=True).Activate     Selection.Interior.ColorIndex = 4    '加亮显示 End Sub 以上代码首先使用FindFormat属性设置查找的格式条件,接着使用Find方法按格式查找并激活满足条件的单元格,最后加亮显示激活单元格。 例24 查找上一个/下一个数据 1.案例说明 打开本例工作簿,单击右上角的“查找”按钮,将弹出输入查找条件对话框,在对话框中输入查找条件单击“确定”按钮,即可在当前工作表中查找满足条件的单元格,找到满足条件的单元格后,选中该单元格。 单击“向前查找”或“向后查找”按钮,可从当前单元格向前或向后查找满足前面设置条件的单元格,并选中该单元格。 如果在使用“查找”按钮输入查找条件之前,就直接单击“向前查找”或“向后查找”按钮,也将弹出 “查找”对话框输入查询条件。 要重设查找条件,单击“查找”按钮打开对话框即可。 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 Sub     Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)     If Not c Is Nothing Then         c.Activate     End If End Sub 以上代码首先提示用户输入查询条件,再使用Find方法向下查找。 (3)“向前查找”按钮的VBA代码如下: Sub 向前查找()     Dim result As String, str1 As String, str2 As String     If c Is Nothing Then         result = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)         If result = "False" Or result = "" Then Exit Sub         Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlPrevious, False)     Else         Set c = ActiveSheet.Cells.FindPrevious(c)     End If     If Not c Is Nothing Then         c.Activate     End If End Sub 以上代码首先判断模块变量c是否为空(判断执行该子过程之前是否设置了查询条件),若为空,则打开对话框让用户输入查询条件,并使用Find方法向前查找。若模块变量c不为空,则调用FindPrevious方法向前查找。 (4)“向后查找”按钮的VBA代码如下: Sub 向后查找()     Dim result As String, str1 As String, str2 As String             If c Is Nothing Then         result = Application.InputBox(prompt:="请输入要查找的值:", Title:="查找", Type:=2)         If result = "False" Or result = "" Then Exit Sub             Set c = ActiveSheet.Cells.Find(result, , , xlWhole, xlByColumns, xlNext, False)     Else         Set c = ActiveSheet.Cells.FindNext(c)     End If     If Not c Is Nothing Then         c.Activate     End If End Sub 例25 代码转换 1.案例说明 打开本例工作簿,在单元格C3中输入“101”,按回车键或Tab键后,单元格C3中输入的值将转换为“财务部”。 单击工作表的“编码”标签,可看到编码表中编码与名称的对应关系。 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 Range     If Target.Column = 3 And Target.Row > 2 And Target.Value <> "" Then         t = Target.Value         With Worksheets("编码")             i = .Range("A1").End(xlDown).Row             Set rng = .Range(.Cells(2, 1), .Cells(i, 1))             Set c = rng.Find(what:=t)             If c Is Nothing Then Exit Sub             Target.Value = c.Offset(0, 1).Value         End With     End If End Sub 以上代码首先对更改单元格的行和列进行判断,如果是第3列第2行以下单元格,则执行编码转换的代码。在转换代码时先获取更改单元格的值,再从“编码”工作表中查找相应的编码,并将查到的编码对应的名称赋值给当前单元格,完成代码的转换。 例26  模糊查询 1.案例说明 打开本例工作簿所示,单击“模糊查询”按钮,弹出对话框,在对话框中输入查询条件“刘”,单击“确定”按钮,即可在工作表中查找含有“刘”字的单元格,并为单元格填充底色。 加亮显示查询结果 2.关键技术 本例使用Like运算符进行模糊查询。Like运算符可用来比较两个字符串。其使用方法如下: result = string Like pattern Like运算符的语法具有以下几个部分: —    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 "张*"      ' 返回 True MyCheck = "F" Like "[A-Z]"      ' 返回 True MyCheck = "F" Like "[!A-Z]"     ' 返回 False MyCheck = "a2a" Like "a#a"      ' 返回 True 3.编写代码 “模糊查询”按钮的VBA代码如下: Sub 模糊查询()     Dim result As String, str1 As String     Dim c As Range, rng As Range     result = Application.InputBox(prompt:="请输入要查找的值:", _         Title:="模糊查找", Type:=2)     If result = "False" Or result = "" Then Exit Sub         Application.ScreenUpdating = False     Application.DisplayAlerts = False         Set rng = ActiveSheet.Range("A1").CurrentRegion     str1 = "*" & result & "*"     For Each c In rng.Cells         If c.Value Like str1 Then             c.Interior.ColorIndex = 4         End If     Next         Application.ScreenUpdating = True     Application.DisplayAlerts = True End Sub 以上代码首先让用户输入查询条件,接着使用For循环逐个单元格进行比较,在比较时使用Like进行模糊查询,如果单元格中包含有指定条件的值,则设置单元格的底色。 例27  网上查询快件信息 1.案例说明 使用本例代码可查询申通快递的快件投递情况。打开本例工作簿,单击“查询快件”按钮打开对话框,在对话框中输入快件编号,单击“确定”按钮,经过一段时间后得到查询结果。 —  本例使用的快件编号进行了处理(虚拟编号),在使用本例代码之前应确保计算已接入互联网。 2.关键技术 (1)QueryTable对象 QueryTable对象代表一个利用从外部数据源(如SQL Server、Microsoft Access数据库、网络数据等)返回的数据生成的工作表表格。 QueryTable对象是QueryTables集合的成员。 (2)Add方法 使用QueryTables集合对象的Add方法可新建一个查询表。其语法格式如下: 表达式.Add(Connection, Destination, Sql) 该方法参数的含义如下: —    Connection:查询表的数据源。可为连接数据库的连接字符串,也可以是一个Web查询。Web查询字符串的格式如下: 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 将打开的查询页面,在文本区中输入快件编号,单击“查询”按钮即可在网页上显示指定编号的快件投递情况。 通过网页查询快件投递情况 如果要在Excel中通过VBA查询快件投递情况,只需要将前面的URL地址中的“wen=”字符串后面加上快件编号即可。 3.编写代码 “查询快件”按钮的VBA代码如下: Sub 查询快件()     Dim str As String, strURL As String         str = Application.InputBox(prompt:="请输入快件的编号:", _         Title:="申通快件查询", Type:=2)             If str = "False" Then Exit Sub         strURL = "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 With End Sub 例28  查询基金信息 1.案例说明 打开本例工作簿,单击“查询基金信息”按钮,将在当前工作表中显示当前基金的信息。 2.关键技术 在网站http://tw.stock.yahoo.com/us/worldinx.html中可查询基金的信息。 在基金信息网页中,上面用6个表格显示了一些超链接信息。最下方的表格显示具体各基金的数据,本例通过Web查询只需要获取下方的表格即可。通过查看HTML代码,可知该表格是第7个表格,所以需要设置QueryTable对象的WebTables属性为7。 3.编写代码 “查询基金信息”按钮的VBA代码如下: Sub 查询基金信息()     Dim strURL As String     strURL = "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:=False     End With End Sub 例29  查询手机所在地 1.案例说明 打开本例工作簿,单击“手机所在地”按钮打开对话框,输入手机号码后,单击“确定”按钮即可查询出手机所在地。 2.关键技术 本例与前面各例使用的Web查询不同。本例使用http://www.123cha.com/网站来查询手机所在地。其查询的HTML代码如下:
请输入要查询的手机号码前七位全部:  
从以上HTML代码可以看出,查询手机所在地使用的是POST方法(另一种方式是GET方式,前面两例使用的这种方式),这种方法将传递一个查询变量到目标页面,需要提供以下两个参数: —    第一个是查询页面,即QueryTable对象的Connection参数。该参数应该是
标签中的action关键字后面的页面。 —    另一个参数是POST方法的字符串,用于向Web服务器输入数据以从Web查询中返回数据。该参数通过PostText属性进行设置,设置该属性的值应该按以下格式:      .PostText = "query_mobile=13988888888" 其中query_mobile为HTML页面中用户输入参数的域的名称。 3.编写代码 “手机所在地”按钮的VBA代码如下: Sub 查询手机所在地()     Dim str As String, strURL As String         str = Application.InputBox(prompt:="请输入手机号码:", _         Title:="手机所在地查询", Type:=2)             If str = "False" Then Exit Sub     If Left(str, 2) <> "13" Then         MsgBox "请输入正确的手机号码!", vbCritical + vbOKOnly, "提示"         Exit Sub     End If         strURL = "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:=False     End With End Sub 例30  使用字典查询 1.案例说明 打开本例工作簿,在所示工作表中列出了员工的姓名,“工资”列为空。单击“查询基础工资”按钮,“工资”列将自动填充员工对应的工资数据。 “基础工资表”工作表中的数据,本例根据该工作表中的数据自动填充对应员工的工资。 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, ds     Dim j As Long, k As Long, i As Long     Application.ScreenUpdating = False         Set ds = CreateObject("Scripting.Dictionary")   '创建数据字典对象         With Worksheets("工资表")         j = .Range("B2").End(xlDown).Row         .Range("B3:B" & j) = ""               清除“工资”列中的数据         k = .Range("A3").End(xlDown).Row         arr = .Range("A3:A" & k)              将“姓名”列赋值到数组中         For i = 3 To k                    将每个姓名作为一个字典对象的数据项             ds.Add arr(i - 2, 1), ""         Next     End With         With Worksheets("基础工资表")         j = .Range("A3").End(xlDown).Row         arr = .Range("A3:B" & j)     End With     On Error Resume Next     For 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)     Next     Worksheets("工资表").Range("B3").Resize(k - 2, 1) = _         WorksheetFunction.Transpose(ds.Items)     Set ds = Nothing     Application.ScreenUpdating = True End Sub     数据排序 在Excel 2007中,在“开始”选项卡的“编辑”组中单击“排序和筛选”按钮,从下拉的菜单按钮中选择相应的命令即可进行排序操作。在VBE中,可使用Sort方法进行排序相关的操作,本节实例演示数据排序的VBA代码 例31  用VBA代码排序 1.案例说明 打开本例工作簿,单击左上角的“按姓名排序”按钮,工作表中的数据按姓名升序排列。 2.关键技术 在Excel 2007操作环境中进行排序时,在单元格中单击作为关键字的列,选择“开始”选项卡“编辑”组中的“排序和筛选”按钮中的相关命令可对工作表中的数据进行排序。但这时参与排序的是所有数据行,在工作表中的数据排序时,最后一行(“合计”)也参与排序,使数据出现不希望的排序结果。 这时使用VBA代码可方便地控制排序的区域,Range对象的Sort方法可对值区域进行排序。其语法格式如下: 表达式.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3) 该方法有很多参数,这些参数都可省略。各参数的含义如下: —    Key1:指定第一排序字段,作为区域名称(字符串)或Range对象;确定要排序的值。 —    Order1:确定Key1中指定的值的排序次序,可设置为常量xlAscending(升序)或xlDescending(降序)。 —    Key2:第二排序字段。 —    Type:指定要排序的元素。 —    Order2:确定Key2中指定的值的排序次序。 —    Key3:第三排序字段。 H:\fanwen caiji two\演讲稿(国土).doc—    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 Long     r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count     c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count     Set 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方法按“姓名”列进行排序。 例32  乱序排序 1.案例说明 在很多情况下,希望得到一种无序的数据排列,使用乱序排序的方法可得到这种效果,本例演示这种效果。打开本例工作簿,单击工作表左上角的“乱序排序”按钮,工资表中的数据将呈无序排列。 2.关键技术 使用乱序排序的一种算法是:在需要排序的数据右侧生成一列随机数据,然后以该随机数的列作为关键字进行排序,即可得到乱序的效果。 3.编写代码 “乱序排序”按钮的VBA代码如下: Sub 乱序排序()     Dim rng As Range, r As Long, c As Long         Randomize     Application.ScreenUpdating = False     With ActiveSheet         r = .Range("A1").CurrentRegion.Rows.Count         c = .Range("A2").CurrentRegion.Columns.Count                 For i = 3 To r – 1     '添加随机数据             .Cells(i, c + 1) = Int((Rnd * 100) + 1)         Next                 Set 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 With     Application.ScreenUpdating = True End Sub 以上代码首先在需要排序的数据右列添加随机数据,再使用Sort方法按该列的数据进行排序,最后删除增加的随机数据列。 例33  自定义序列排序 1.案例说明 打开本例工作簿,单击“自定义序列排序”按钮,工作表中的数据将按C列(部门)中的数据按自定义序列排序。自定义序列,在工作表中更改数据的排列顺序后,再单击“自定义序列排序”按钮,C列(部门)又将按新的序列重新排列。 2.关键技术 本例演示用VBA代码创建自定义序列的方法,主要用AddCustomList方法添加自定义序列,用DeleteCustomList方法删除自定义序列。 (1)AddCustomList方法 用该方法为自定义自动填充和/或自定义排序添加自定义列表。其语法格式如下: 表达式.AddCustomList(ListArray, ByRow)                        参数的含义如下: —    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 Integer     Dim rng1 As Range, arr1         Application.ScreenUpdating = False                     '获取排序的单元格区域     r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count     c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count     Set rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))                     '添加自定义序列     With Worksheets("Sheet2")         r = .Range("A1").End(xlDown).Row         Set rng = .Range(.Cells(1, 1), .Cells(r, 1))     End With         With Application         arr1 = .WorksheetFunction.Transpose(rng)         .AddCustomList ListArray:=arr1         n = .GetCustomListNum(arr1)     End With                 '用自定义序列排序     rng1.Sort key1:=ActiveSheet.Range(Cells(3, 3), Cells(r - 1, 3)), _         Order1:=xlAscending, Header:=xlGuess, OrderCustom:=n + 1     Application.DeleteCustomList ListNum:=n '删除自定义序列         Application.ScreenUpdating = True End Sub 以上代码首先获取需要排序的单元格区域,接着将工作表Sheet 2中的数据添加到自定义序列中,再使用自定义序列进行排序,最后删除自定义序列。 例34  多关键字排序 1.案例说明 在Excel中对数据进行排序时,最多只能使用3个关键字排序,如果3个关键字相同时,要使用4个或更多关键字排序就比较麻烦。本例演示使用4个关键字排序的方法。 打开本例工作簿,单击工作表左上角的“多关键字排序”按钮,工作表中的数据将按C列到F列(共4列)的数据进行排序,得到结果。从图中可以看出,首先按C列(部门)排序,部门相同时再按D列(基础工资)排序,基础工资相同再按E列(岗位工资)排序,岗位工资相同再按F列(工龄工资)排序。如销售部两员工的基础工资、岗位工资都相同,则按工龄工资排序(陈晴工龄工资低,排在前面)。 2.关键技术 对于超过三个关键字的排序,本例使用的方法时,先将数据按最后一个关键字排序,接着再将数据按倒数第二个关键字排序,……,最后将数据按主要(第一个)关键字排序,即可得到所需要的排列。 使用这种方法,可使用任意数量的关键字进行排序。 3.编写代码 “多关键字排序”按钮的VBA代码如下: Sub 多关键字排序()     Dim rng1 As Range, r As Long, c As Long, i As Integer     Application.ScreenUpdating = False     '获取排序的单元格区域     r = ActiveSheet.Range("A1").CurrentRegion.Rows.Count     c = ActiveSheet.Range("A2").CurrentRegion.Columns.Count     Set rng1 = ActiveSheet.Range(Cells(3, 1), Cells(r - 1, c))          With rng1         For i = 6 To 3 Step -1             .Sort key1:=ActiveSheet.Range("C3").Offset(, i - 3)         Next     End With     Application.ScreenUpdating = True End Sub 例35  输入数据自动排序 1.案例说明 打开本例工作簿,在B列中输入姓名,当按回车键或Tab键完成该列单元格的输入时,输入的数据将自动按顺序排列到工作表的相应行中。 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个单元格区域作为参数,至少需使用两个参数。 在本例中,使用以下表示方法判断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 Then         Set rng = ActiveSheet.Range("A1").CurrentRegion         Set rng = rng.Offset(2, 0).Resize(rng.Rows.Count - 2, rng.Columns. Count)         rng.Sort Key1:=Range("B3")     End If End Sub 以上代码首先判断更改数据的单元格是否为第2列,接着判断更改数据单元格是否为“B3:B1000”单元格区域中的单元格,然后获取当前区域需要排序的单元格区域,使用Sort方法对这个区域进行排序即可。 例36 数组排序 1.案例说明 打开本例工作簿所示,单击“生成随机数”按钮,打开对话框,在对话框中输入需要生成的随机数数量,单击“确定”按钮即可生成相应的随机数。 单击“排序”按钮,将生成的随机数按升序排列。 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 Long         Randomize Timer     n = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _         Title:="输入数量", Default:=10, Type:=1)     If n <= 0 Or r > 65536 Then Exit Sub         ReDim arr(1 To n)                         '定义动态数组     For i = 1 To n                            '循环生成随机数         arr(i) = Int(Rnd * 10000)     Next     With ActiveSheet         .Columns(1).Clear         .Range("A1:A" & n) = Application.Transpose(arr)  '数组赋值给单元格区域     End With End Sub (2)“排序”按钮的VBA代码如下: Sub排序()     Dim arr, t     Dim i As Long, j As Long, n As Long         n = ActiveSheet.Range("A1").End(xlDown).Row     If n <= 1 Then Exit Sub         arr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中         For i = 1 To n - 1                        '双循环排序         For j = i + 1 To n             If arr(j, 1) < arr(i, 1) Then                 t = arr(i, 1)                '交换数据                 arr(i, 1) = arr(j, 1)                 arr(j, 1) = t             End If         Next     Next     ActiveSheet.Range("A1:A" & n) = arr      '数组赋值给单元格区域 End Sub 例37 使用Small和Large函数排序 1.案例说明 打开本例工作簿,在工作表中单击“生成随机数”按钮将打开对话框,在对话框中输入产生随机数的个数,单击“确定”按钮将在工作表中的A列生成指定数量的随机数。 单击“升序排序”按钮,生成的随机数将按从小到大的顺序排列。单击“降序排序”按钮,生成的随机数将按从大到小的顺序排列。 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 Long         Randomize Timer     n = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _         Title:="输入数量", Default:=10, Type:=1)     If n <= 0 Or r > 65536 Then Exit Sub         ReDim arr(1 To n)                '定义动态数组     For i = 1 To n               '循环生成随机数         arr(i) = Int(Rnd * 10000)     Next     With ActiveSheet         .Columns(1).Clear         .Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '数组赋值给单元格区域     End With End Sub (2)“升序排序”按钮的VBA代码如下: Sub 升序排序()     Dim arr, arr1(), i As Long, n As Long         n = ActiveSheet.Range("A1").End(xlDown).Row     If n <= 1 Then Exit Sub     arr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中         ReDim arr1(1 To n)     For i = 1 To n                           '选出第i个最小的数         arr1(i) = WorksheetFunction.Small(arr, i)     Next     ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)                                             '数组赋值给单元格区域 End Sub (3)“降序排序”按钮的VBA代码如下: Sub 降序排序()     Dim arr, arr1(), i As Long, n As Long         n = ActiveSheet.Range("A1").End(xlDown).Row     If n <= 1 Then Exit Sub     arr = ActiveSheet.Range("A1:A" & n)      '单元格区域保存到数组中         ReDim arr1(1 To n)     For i = 1 To n                          '选出第i个最大的数         arr1(i) = WorksheetFunction.Large(arr, i)     Next     ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr1)                                 '数组赋值给单元格区域 End Sub 例38 使用RANK函数排序 1.案例说明 打开本例工作簿,单击“生成随机数”按钮在工作表中的A列生成指定数量的随机数。单击“排序”按钮,生成的随机数将按从小到大的顺序排列。 2.关键技术 使用WorksheetFunction对象的Rank方法,可返回一个数字在数字列表中的排位。数字的排位是其大小与列表中其他值的比值(如果列表已排过序,则数字的排位就是它当前的位置)。 Rank方法语法的语法格式如下: 表达式.Rank(Arg1, Arg2, Arg3) 各参数的含义如下: —    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 Long         Randomize Timer     n = Application.InputBox(prompt:="请输入要生成的随机数数量(2-65536):", _         Title:="输入数量", Default:=10, Type:=1)     If n <= 0 Or r > 65536 Then Exit Sub         ReDim arr(1 To n)                                            '定义动态数组     For i = 1 To n                                           '循环生成随机数         arr(i) = Int(Rnd * 10000)     Next     With ActiveSheet         .Columns(1).Clear         .Range("A1:A" & n) = WorksheetFunction.Transpose(arr) '数组赋值给单元格区域     End With End Sub (2)“排序”按钮的VBA代码如下: Sub 排序()     Dim arr, rng As Range, t As Long, i As Long         n = ActiveSheet.Range("A1").End(xlDown).Row     If n <= 1 Then Exit Sub     ReDim arr(1 To n)         Set rng = ActiveSheet.Range("A1:A" & n)      '获取单元格区域引用         For i = 1 To n         t = WorksheetFunction.Rank(rng(i, 1), rng, 1)         arr(t) = rng(i, 1)     Next            ActiveSheet.Range("A1:A" & n) = WorksheetFunction.Transpose(arr)                                                 '数组赋值给单元格区域 End Sub 例39  姓名按笔画排序 1.案例说明 在各种会议中,对出席会议(或选举产生)的人员需要列出名单,这些名单一般是按姓名笔画排序。Excel提供了按笔画排序的方法,但用这种方法排序时也将会出现一些问题,例如:姓名为双字的,一般要在姓和名之间加上一个空格,若为女性或少数民族,还要在姓名后面用括号标明。 本例编写VBA代码,对姓名按笔画排序,能自动处理姓名之间有空格、有括号的情况。打开本例工作簿,单击“按姓名笔画排序”按钮,将得到排序结果。 本例自动生成按笔画排序的汉字库表。该工作表根据“姓名”工作表中的汉字自动生成 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 Integer     Dim c As String, xm As String, c1 As String     Dim str1 As String, n As Long     Dim arr, arr1()         Application.ScreenUpdating = False     Set ds = CreateObject("Scripting.Dictionary")    '创建数据字典对象     With Worksheets("姓名")         r = .Range("A1").End(xlDown).Row         On Error Resume Next         For i = 1 To r             str1 = .Cells(i, 1).Value              '获取单元格的姓名             For j = 1 To Len(str1)                 '将字符串拆分为单个汉字                 s = Mid(str1, j, 1)                 If s <> " " Then                     ds.Add s, s                       '添加字典中                     If Err <> 0 Then Err.Clear                 End If             Next         Next         On Error GoTo 0     End With         r = ds.Count                                 '字典中的条目数量     With Worksheets("汉字库")         .Columns(1).Clear                         '清除A列         .Range("A1").Resize(r, 1) = _             WorksheetFunction.Transpose(ds.Items)  '将字典中的数字填充到A列                 r = .Range("A1").End(xlDown).Row         With .Sort                             '对A列按笔画排序             .SetRange Range("A1:A" & r)             .Header = xlGuess             .MatchCase = False             .Orientation = xlTopToBottom             .SortMethod = xlStroke             .Apply         End With         arr = .Range("A1:A" & r)     End With     ds.RemoveAll                                 '删除字典中的所有数据         For i = 1 To r                               '把汉字添加到字典中         ds.Add arr(i, 1), i     Next        With Worksheets("姓名")         r = .Range("A1").End(xlDown).Row         ReDim arr1(1 To r, 1 To 2)                 '生定义数组                 For i = 1 To r             c = .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"))             Next             arr1(i, 2) = c1                     '保存姓名的序列码字符串         Next             For i = 1 To r – 1                     '双循环排序             For j = i + 1 To r                 If 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) = t1                     arr1(j, 2) = t2                 End If             Next         Next          .Range("A1:A" & r) = arr1                 '将排序后的数组填充到单元格区域     End With         Application.ScreenUpdating = True End Sub     数据筛选 在Excel 2007中,在“开始”选项卡的“编辑”组中单击“排序和筛选”按钮,从下拉的菜单按钮中选择相应的命令即可进行数据筛选操作。在VBE中,可使用AutoFilter方法进行自动筛选操作,使用AdvancedFilter方法可进行高级筛选操作,本节实例演示数据筛选的VBA代码。 例40  用VBA进行简单筛选 1.案例说明 打开本例工作簿,单击工作表左上角的“筛选”按钮弹出对话框,在对话框中输入筛选条件“财务部”,单击“确定”按钮,工作表中将自动出现自动筛选下拉箭头,并且只显示“部门”为“财务部”的数据。 在 “筛选”对话框中不输入任何值,直接单击“确定”按钮即可显示全部数据。                   2.关键技术 使用Range对象的AutoFilter方法,可对Range区域的数据中使用“自动筛选”筛选一个列表。该方法的语法如下: 表达式.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown) 各参数的含义如下: —    Field:相对于作为筛选基准字段(从列表左侧开始,最左侧的字段为第一个字段)的字段的整型偏移量。 —    Criteria1:筛选条件,为一个字符串。使用“=”可查找空字段,或者使用“<>”查找非空字段。如果省略该参数,则搜索条件为All。如果将Operator设置为xlTop10Items,则Criteria1指定数据项个数(例如,“10”)。 —    Operator:指定筛选类型,可用常量如表12-2所示。 表12-2  筛选类型 名    称 值 描    述 xlAnd 1 条件1和条件2的逻辑与 xlBottom10Items 4 显示最低值项(条件1中指定的项数) xlBottom10Percent 6 显示最低值项(条件1中指定的百分数) xlFilterCellColor 8 单元格颜色 xlFilterDynamic 11 动态筛选 xlFilterFontColor 9 字体颜色 xlFilterIcon 10 筛选图标 xlFilterValues 7 筛选值 xlOr 2 条件1和条件2的逻辑或 xlTop10Items 3 显示最高值项(条件1中指定的项数) xlTop10Percent 5 显示最高值项(条件1中指定的百分数) —    Criteria2:第二个筛选条件(一个字符串)。与Criteria1和Operator一起组合成复合筛选条件。 —    VisibleDropDown:如果为True,则显示筛选字段的自动筛选下拉箭头。如果为False,则隐藏筛选字段的自动筛选下拉箭头。默认值为True。 —   如果忽略全部参数,此方法仅在指定区域切换自动筛选下拉箭头的显示。 3.编写代码 “筛选”按钮的VBA代码如下: Sub 筛选()     Dim str1 As String    str1 = Application.InputBox(prompt:="请输入要筛选的部门名称(空字符将显示全部数据):", _         Title:="筛选", Type:=2)     If str1 = "False" Then Exit Sub         If str1 = "" Then        Worksheets("Sheet1").Range("A1").AutoFilter  field:=3     Else         Worksheets("Sheet1").Range("A1").AutoFilter _          field:=3, _          Criteria1:=str1     End If End Sub 以上代码首先要求用户输入筛选条件,接着判断用户输入的是否为空,若为空,则显示全部数据,若输入的筛选条件不为空,则筛选等于输入条件的数据。 例41  用VBA进行高级筛选 1.案例说明 打开本例工作簿,在下方的“条件区域”部分输入条件,再单击左上角的“高级筛选”按钮,即可按条件区域中输入的条件对数据进行高级筛选,得到结果。 如果在条件区域删除数据,再单击“高级筛选”按钮,工作表将显示全部数据(取消高级筛选功能)。 图12-58  高级筛选结果 若在条件区域不同行输入条件,则将采用逻辑或关系筛选数据(即只要满足一列条件即可),可显示“人事部”或“基础工资”大于1400的数据。 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 Range         Application.ScreenUpdating = False     Application.Calculation = xlCalculationManual    '手动重算         Set rng = Worksheets("Sheet1").Range("A19").CurrentRegion     Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)         Set rng1 = Worksheets("Sheet1").Range("A1").CurrentRegion     Set rng1=rng1.Offset(1,0).Resize(rng1.Rows.Count-1, rng1.Columns.Count)         rng1.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rng     Application.Calculation = xlCalculationAutomatic '自动重算     Application.ScreenUpdating = True End Sub 以上代码首先获取工作表中条件区域和筛选数据区域的引用,最后使用AdvancedFilter方法对数据区域进行筛选。 例42 筛选非重复值 1.案例说明 打开本例工作簿,单击工作表中的“生成随机数”按钮,将在工作表的A列生成1000个随机数,再单击“筛选非重复值”按钮,可将左侧生成的1000个随机数中的非重复数筛选并复制到B列中。 2.关键技术 本例使用Range对象的AdvancedFilter方法筛选非重复值,有关该方法的介绍参见上例中的内容。 3.编写代码 (1)“生成随机数”按钮的VBA代码如下: Sub 生成随机数()     Dim i As Integer         Application.ScreenUpdating = False     Randomize     With ActiveSheet         For i = 2 To 1001             .Cells(i, 1) = Int(Rnd * 1000 + 1)         Next     End With     Application.ScreenUpdating = True End Sub (2)“筛选非重复值”按钮的VBA代码如下: Sub 筛选非重复值()     Dim i As Long, rng As Range         Application.ScreenUpdating = False         With ActiveSheet         i = .Range("A1").End(xlDown).Row         If i > 1001 Then Exit Sub         Set rng = .Range(Cells(2, 1), Cells(i, 1))                 .Columns("B").ClearContents         rng.AdvancedFilter Action:=xlFilterCopy, _         CopyToRange:=.Range("B2"), Unique:=True     End With     Application.ScreenUpdating = True End Sub 例43  取消筛选 1.案例说明 打开本例工作簿所示,在如图所示工作表中设置了自动筛选,单击“取消筛选”按钮,当前工作簿中每个工作表中的自动筛选都将取消。 2.关键技术 如果当前在工作表上显示有“自动筛选”下拉箭头,则AutoFilterMode属性值为True。设置该属性值为False可取消自动筛选状态。 —   不能将该属性设置为True。使用AutoFilter方法可筛选列表并显示下拉箭头。 3.编写代码 “取消筛选”按钮的VBA代码如下: Sub 取消筛选()     Dim ws1 As Worksheet     For Each ws1 In Worksheets         ws1.AutoFilterMode = False     Next End Sub
本文档为【43个典型ExcelVBA实例】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
该文档来自用户分享,如有侵权行为请发邮件ishare@vip.sina.com联系网站客服,我们会及时删除。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。
下载需要: ¥17.0 已有0 人下载
最新资料
资料动态
专题动态
个人认证用户
豆浆
暂无简介~
格式:doc
大小:271KB
软件:Word
页数:63
分类:工学
上传时间:2019-05-17
浏览量:216