(完整版)ExcelVBA编程实例(150例)

ExcelVBA编程实例（150例）主要内容和特点《ExcelVBA编程入门范例》主要是以一些基础而简短的VBA实例来对ExcelV BA中的常用对象及其属性和方法进行讲解，包括应用程序对象、窗口、工作簿、工作表、单元格和单元格区域、图表、数据透视表、形状、控件、菜单和工具栏、帮助助手、格式化操作、文件操作、以及常用方法和函数及技巧等方面的应用示例。

这些例子都比较基础，很容易理解，因而，很容易调试并得以实现，让您通过具体的实例来熟悉ExcelVBA编程。

■ 分16章共14个专题，以具体实例来对大多数常用的ExcelVBA对象进行讲解；■ 一般而言，每个实例都很简短，用来说明使用VBA实现Excel某一功能的操作；■ 各章内容主要是实例，即VBA代码，配以简短的说明，有些例子可能配以必要的图片，以便于理解；■ 您可以对这些实例进行扩充或组合，以实现您想要的功能或更复杂的操作。

VBE编辑器及VBA代码输入和调试的基本知识在学习这些实例的过程中，最好自已动手将它们输入到VBE编辑器中调试运行，来查看它们的结果。

当然，您可以偷赖，将它们复制/粘贴到代码编辑窗口后，进行调试运行。

下面，对VBE编辑器界面进行介绍，并对VBA代码输入和调试的基本知识进行简单的讲解。

激活VBE编辑器一般可以使用以下三种方式来打开VBE编辑器：■ 使用工作表菜单“工具——宏——Visual Basic编辑器”命令，如图00-01所示；■ 在Visual Basic工具栏上，按“Visual Basic编辑器”按钮，如图00-02所示；■ 按Alt+F11组合键。

图00-01：选择菜单“工具——宏——Visual Basic编辑器”命令来打开VBE编辑器图00-02：选择Visual Basic工具栏上的“Visual Basic编辑器”命令按钮来打开VBE编辑器此外，您也可以使用下面三种方式打开VBE编辑器：■ 在任一工作表标签上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问该工作表的代码模块，如图00-03所示；■ 在工作簿窗口左上角的Excel图标上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问活动工作簿的ThisWorkbook代码模块，如图00-04所示；■ 选择菜单“工具——宏——宏”命令打开宏对话框，若该工作簿中有宏程序，则单击该对话框中的“编辑”按钮即可进行VBE编辑器代码模块，如图00-05所示。

43个典型ExcelVBA实例目录例1.九九乘法表（Print方法的应用） (3)例2 输入个人信息（Inputbox函数的应用） (3)例3 退出确认（Msgbox函数的应用） (5)例4 突出显示不及格学生 (7)例5 从身份证号码中提取性别 (8)例6 评定成绩等级 (9)例7 计算个人所得税 (11)例8 密码验证 (13)例9 求最小公倍数和最大公约数 (15)例10 输出ASCII码表 (16)例11 计算选中区域数值之和 (17)例12 换零钱法（多重循环） (18)例13 数据排序 (21)例14 彩票幸运号码 (22)例15 用数组填充单元格区域 (24)例16 判断单元格是否包含公式 (25)例17 自动填充公式 (26)例18 锁定和隐藏公式 (28)例19 将单元格公式转换为数值 (29)例20 删除所有公式 (29)例21 用VBA表示数组公式 (30)数据查询 (31)例22 查找指定的值 (31)例23 带格式查找 (33)例24 查找上一个/下一个数据 (34)例25 代码转换 (36)例26 模糊查询 (37)例27 网上查询快件信息 (38)例28 查询基金信息 (40)例29 查询手机所在地 (41)例30 使用字典查询 (43)数据排序 (45)例31 用VBA代码排序 (45)例32 乱序排序 (46)例33 自定义序列排序 (47)例34 多关键字排序 (49)例35 输入数据自动排序 (50)例36 数组排序 (51)例37 使用Small和Large函数排序 (52)例38 使用RANK函数排序 (54)例39 姓名按笔画排序 (56)例40 用VBA进行简单筛选 (59)例41 用VBA进行高级筛选 (61)例42 筛选非重复值 (62)例43 取消筛选 (63)：例1.九九乘法表（Print方法的应用）1．案例说明在早期的Basic版本中，程序运行结果主要依靠Print语句输出到终端。

43个典型ExcelVBA实例目录例1.九九乘法表（Print方法的应用） (3)例2 输入个人信息（Inputbox函数的应用） (3)例3 退出确认（Msgbox函数的应用） (5)例4 突出显示不及格学生 (7)例5 从身份证号码中提取性别 (8)例6 评定成绩等级 (9)例7 计算个人所得税 (11)例8 密码验证 (13)例9 求最小公倍数和最大公约数 (15)例10 输出ASCII码表 (16)例11 计算选中区域数值之和 (17)例12 换零钱法（多重循环） (18)例13 数据排序 (21)例14 彩票幸运号码 (22)例15 用数组填充单元格区域 (24)例16 判断单元格是否包含公式 (25)例17 自动填充公式 (26)例18 锁定和隐藏公式 (28)例19 将单元格公式转换为数值 (29)例20 删除所有公式 (29)例21 用VBA表示数组公式 (30)数据查询 (31)例22 查找指定的值 (31)例23 带格式查找 (33)例24 查找上一个/下一个数据 (34)例25 代码转换 (36)例26 模糊查询 (37)例27 网上查询快件信息 (38)例28 查询基金信息 (40)例29 查询手机所在地 (41)例30 使用字典查询 (43)数据排序 (45)例31 用VBA代码排序 (45)例32 乱序排序 (46)例33 自定义序列排序 (47)例34 多关键字排序 (49)例35 输入数据自动排序 (50)例36 数组排序 (51)例37 使用Small和Large函数排序 (52)例38 使用RANK函数排序 (54)例39 姓名按笔画排序 (56)例40 用VBA进行简单筛选 (59)例41 用VBA进行高级筛选 (61)例42 筛选非重复值 (62)例43 取消筛选 (63)：例1.九九乘法表（Print方法的应用）1．案例说明在早期的Basic版本中，程序运行结果主要依靠Print语句输出到终端。

第一章Excel应用程序对象(Application对象)及其常用方法Application对象代表整个Microsoft Excel应用程序，带有175个属性和52个方法，可以设置整个应用程序的环境或配置应用程序。

示例01-01：体验开/关屏幕更新(ScreenUpdating属性)Sub 关闭屏幕更新()MsgBox "顺序切换工作表Sheet1→Sheet2→Sheet3→Sheet2，先开启屏幕更新，然后关闭屏幕更新"Worksheets(1).SelectMsgBox "目前屏幕中显示工作表Sheet1"Application.ScreenUpdating = TrueWorksheets(2).SelectMsgBox "显示Sheet2了吗？"Worksheets(3).SelectMsgBox "显示Sheet3了吗？"Worksheets(2).SelectMsgBox "下面与前面执行的程序代码相同,但关闭屏幕更新功能" Worksheets(1).SelectMsgBox "目前屏幕中显示工作表Sheet1" & Chr(10) & "关屏屏幕更新功能" Application.ScreenUpdating = FalseWorksheets(2).SelectMsgBox "显示Sheet2了吗？"Worksheets(3).SelectMsgBox "显示Sheet3了吗？"Worksheets(2).SelectApplication.ScreenUpdating = TrueEnd Sub示例说明：ScreenUpdating属性用来控制屏幕更新。

当运行一个宏程序处理涉及到多个工作表或单元格中的大量数据时，若没有关闭屏幕更新，则会占用CP U的处理时间，从而降低程序的运行速度，而关闭该属性则可显著提高程序运行速度。

Excel-vba宏代码-大全宏文件集▲打开全部隐藏工作表返回Sub 打开全部隐藏工作表()Dim i As IntegerFor i = 1 To Sheets.CountSheets(i).Visible = TrueNext iEnd Sub▲循环宏返回Sub 循环()AAA = Range("C2")Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i = 1 To timesCall 过滤一行If Range("完成标志") = "完成" Then Exit For '如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A" & i).Text = "完成" Then Exit For '如果某列出现"完成"内容则退出循环Next iEnd Sub▲录制宏时调用“停止录制”工具栏返回Sub 录制宏时调用停止录制工具栏()/doc/4911298482.html,mandBars("Stop Recording").Visible = TrueEnd Sub▲高级筛选5列不重复数据至指定表返回Sub 高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D 列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range( _"A1"), Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"), Order1:=xlAscending,Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYinEnd Sub▲双击单元执行宏(工作表代码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4Cancel = TrueEnd SelectEnd Sub▲双击指定区域单元执行宏(工作表代码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then Call 打开隐藏表End Sub▲进入单元执行宏(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$5" '单元地址(Target.Address),或命名单元名字(/doc/4911298482.html,)Call 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3End SelectEnd Sub▲进入指定区域单元执行宏(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9")) Is Nothing Then Call打开隐藏表▲在多个宏中依次循环执行一个（控件按钮代码）返回Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2宏3RunMacro = 0End SelectEnd Sub▲在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEnd With▲在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Option ExplicitPrivate Sub CommandButton1_Click()With CommandButton1If .Caption = "宏1" ThenCall 宏1.Caption = "宏2"Exit SubEnd IfIf .Caption = "宏2" ThenCall 宏2.Caption = "宏3"Exit SubEnd IfIf .Caption = "宏3" ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub▲根据A1单元文本隐藏/显示按钮（控件按钮代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A1") > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub▲当前单元返回按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()ActiveCell = CommandButton1.CaptionEnd Sub▲当前单元内容返回到按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()CommandButton1.Caption = ActiveCellEnd Sub▲奇偶页分别打印返回Sub 奇偶页分别打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数MsgBox "现在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub▲自动打印多工作表第一页返回Sub 自动打印多工作表第一页() Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("请输入起始工作表名字:")sy = InputBox("请输入结束工作表名字:")y = Sheets(x).Indexsyz = Sheets(sy).IndexFor sh = y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1, To:=1Next shEnd Sub▲查找A列文本循环插入分页符返回Sub 循环插入分页符()' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容Dim i As LongDim times As Longtimes = Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页")'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i = 1 To timesCall 插入分页符Next iEnd SubSub 插入分页符()Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _.ActivateActiveWindow.SelectedSheets.HPageBreaks.AddBefore:=ActiveCellEnd SubSub 取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub▲将A列最后数据行以上的所有B列图片大小调整为所在单元大小返回Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小()Dim Pic As Picture, i&i = [A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing ThenPic.Top = Pic.T opLeftCell.TopPic.Left = Pic.TopLeftCell.LeftPic.Height = Pic.TopLeftCell.HeightPic.Width = Pic.TopLeftCell.WidthEnd IfNextEnd Sub▲返回光标所在行数返回Sub 返回光标所在行数()x = ActiveCell.RowRange("A1") = xEnd Sub▲在A1返回当前选中单元格数量返回Sub 在A1返回当前选中单元格数量()[A1] = Selection.CountEnd Sub▲返回当前工作簿中工作表数量返回Sub 返回当前工作簿中工作表数量()t = Application.Sheets.CountMsgBox tEnd Sub▲返回光标选择区域的行数和列数返回Sub 返回光标选择区域的行数和列数()x = Selection.Rows.County = Selection.Columns.CountRange("A1") = xRange("A2") = yEnd Sub▲工作表中包含数据的最大行数返回Sub 包含数据的最大行数()n = Cells.Find("*", , , , 1, 2).RowMsgBox nEnd Sub▲返回A列数据的最大行数返回Sub 返回A列数据的最大行数() n = Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub▲将所选区域文本插入新建文本框返回Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn = n & rag.Value & Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizon tal, ActiveCell.Left +ActiveCell.Width, ActiveCell.T op + ActiveCell.Height, 250#, 100).SelectSelection.Characters.Text = "问题：" & nWith Selection.Characters(Start:=1, Length:=3).Font.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub▲批量插入地址批注返回Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selection/doc/4911298482.html,ment.Deleter.AddComment/doc/4911298482.html,ment.Visible = False /doc/4911298482.html,ment.Text Text:="本单元格：" & r.Address & " of " & Selection.AddressNextEnd IfEnd Sub▲批量插入统一批注返回Sub 批量插入统一批注()Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随便输点什么吧")If Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddComment/doc/4911298482.html,ment.Visible = False /doc/4911298482.html,ment.TextText:=msgNextEnd IfEnd Sub▲以A1单元内容批量插入批注返回Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddComment/doc/4911298482.html,ment.Visible = False /doc/4911298482.html,ment.TextText:=[a1].T extNextEnd IfEnd Sub▲不连续区域插入当前文件名和表名及地址返回Sub 批量插入当前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "[" + /doc/4911298482.html, + "]" + /doc/4911298482.html, +"!" + mycell.AddressNextEnd Sub▲不连续区域录入当前单元地址返回Sub 区域录入当前单元地址() For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub▲连续区域录入当前单元地址返回Sub 连续区域录入当前单元地址()Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub▲返回当前单元地址返回Sub 返回当前单元地址()d = ActiveCell.Address[A1] = dEnd Sub▲不连续区域录入当前日期返回Sub 区域录入当前日期()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d")End Sub▲不连续区域录入当前数字日期返回Sub 区域录入当前数字日期() Selection.FormulaR1C1 = Format(Now(), "yyyymmdd")End Sub▲不连续区域录入当前日期和时间返回Sub 区域录入当前日期和时间()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss")End Sub▲不连续区域录入对勾返回Sub 批量录入对勾()Selection.FormulaR1C1 = "√"End Sub▲不连续区域录入当前文件名返回Sub 批量录入当前文件名()Selection.FormulaR1C1 = /doc/4911298482.html,End Sub▲不连续区域添加文本返回Sub 批量添加文本()Dim s As RangeFor Each s In Selections = s & "文本内容"NextEnd Sub▲不连续区域插入文本返回Sub 批量插入文本()Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub▲从指定位置向下同时录入多单元指定内容返回Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr = Array("1", "2", "13", "25", "46", "12", "0", "20")[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr)End Sub▲按aa工作表A列的内容排列工作表标签顺序返回Sub 按aa工作表A列的内容排列工作表标签顺序()Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).Value <> ""str1 = Trim(Cells(I, 1).Value)Sheets(str1).SelectSheets(str1).Move after:=Sheets(I)I = I + 1Sheets("aa").SelectLoopEnd Sub▲以A1单元文本作表名插入工作表返回Sub 以A1单元文本作表名插入工作表()Dim nm As Stringnm = [a1]Sheets.Add/doc/4911298482.html, = nmEnd Sub▲删除全部未选定工作表返回Sub 删除全部未选定工作表()Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName() As Stringn = ActiveWindow.SelectedSheets.CountReDim ShtName(1 To n)n = 1For Each sht In ActiveWindow.SelectedSheetsShtName(n) = /doc/4911298482.html,n = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = /doc/4911298482.html, TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub▲工作表标签排序返回Sub 工作表标签排序()Dim i As Long, j As Long, nums As Long, msg As Longmsg = MsgBox("工作表按升序排列请选'是[Y]'. " & vbCrLf & vbCrLf & "工作表按降序排列请选 '否[N]'", vbYesNoCancel, "工作表排序")If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbYes Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iEnd IfEnd Sub▲定义指定工作表标签颜色返回Sub 定义指定工作表标签颜色() Sheets("Sheet1").T ab.ColorIndex = 46End Sub▲在目录表建立本工作簿中各表链接目录返回Sub 在目录表建立本工作簿中各表链接目录()Dim s%, Rng As RangeOn Error Resume NextSheets("目录").ActivateIf Err = 0 ThenSheets("目录").UsedRange.DeleteElseSheets.Add/doc/4911298482.html, = "目录" End If。

Excel常用VBA函数实用经典案例ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：S UB示例_1_01()D IM MY N UM1%,MY N UM2%MY N UM1=A SC("E XCEL")'返回69MY N UM2=A SC("E")'返回101[A1]="MY N UM1=":[B1]=MY N UM1[A2]="MY N UM2=":[B2]=MY N UM2E ND S UB三、代码详解1、Sub示例_1_01()：宏程序的开始语句。

2、Dim myNum1%,myNum2%：变量myNum1和myNum2声明为整型变量。

也可以写为Dim myNum1As Integer。

Integer变量存储为16位（2个字节）的数值形式，其范围为 -32,768到32,767之间。

Integer的类型声明字符是百分比符号(%)。

3、myNum1=Asc("Excel")：把Asc函数的值赋给变量myNum1。

Asc函数返回一个Integer，代表字符串中首字母的字符的ASCII代码。

语法Asc(string)必要的string（字符串）参数可以是任何有效的字符串表达式。

如果string中没有包含任何字符，则会产生运行时错误。

4、myNum2=Asc("e")：把Asc函数的值赋给变量myNum2。

这里返回小写字母e的ASCII代码101。

5、[a1]="myNum1=":[b1]=myNum1：把字符串“myNum1=“赋给A1单元格，把变量myNum1的值赋给B1单元格。

6、[a2]="myNum2=":[b2]=myNum2：把字符串“myNum2=“赋给A2单元格，把变量myNum2的值赋给B2单元格。

1, 类动态数组控件‘2007VBA技巧‘快盘\Mytb\更新\类\类动态数组控件.xlsm‘2013-6-16类模块代码：Public WithEvents frm AsPublic WithEvents myText AsPublic Index As IntegerPrivate Sub myText_Change()Index = Mid, 8)If ("Textbox" & Index) <> "" Then= "控件事件：Change" & vbCrLf & _"控件名称：" & ("Textbox" & Index).Name & vbCrLf & _ "Text属性：" & ("Textbox" & Index).TextEnd IfEnd SubPrivate Sub myText_DblClick(ByVal Cancel AsIndex = Mid, 8)If ("Textbox" & Index) <> "" Then= "控件事件：DblClick" & vbCrLf & _"控件名称：" & ("Textbox" & Index).Name & vbCrLf & _ "Cancel属性：" & CancelEnd IfEnd SubKeyUp事件与Change事件重迭，二者取其一Private Sub myText_KeyUp(ByVal KeyCode As , ByVal Shift As Integer) Index = Mid, 8)If ("Textbox" & Index) <> "" Then= "控件事件：KeyUp" & vbCrLf & _"控件名称：" & ("Textbox" & Index).Name & vbCrLf & _ "按键值：&H" & Hex$(KeyCode)End IfEnd SubPrivate Sub myText_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)Select Case IndexCase 3= "3"Case 8= "8"Case 4= "4"Case 9= "9"Case Else= " "End SelectEnd Sub模块1代码：Public a(1 To 14) As myTextSub formshow()End Sub窗体代码：Private Sub CommandButton1_Click()Dim i&, t$For i = 1 To 14If a(i). <> "" Thent = t & "控件名称：" & a(i). & vbTab & "Text属性：" & a(i). & vbCrLf End IfNext iMsgBox tEnd SubPrivate Sub UserForm_Initialize()Dim i&For i = 1 To 14Set a(i) = New myTextSet a(i).myText = ("Textbox" & i)Set a(i).frm = MeNext iEnd Sub工作表代码：Private Sub CommandButton1_Click()End Sub2, 复选框选择‘快盘\Mytb\更新\类\类0928..xls‘当复选框选择到7个时，其它的复选框不能再选择。

Sub direct_Price()''定义变量Dim cRows As Integer '总行数Dim cColumns As Integer '总列数Dim HEADERCOLORINDEX As Integer '表头的背景色Dim cTemp As Integer '临时计数Dim sTempString As String '临时字符串变量Dim i As Integer '临时计数Dim j As Integer '临时计数Dim rowIndex As Integer '临时指示处理到哪里Dim colIndex As Integer '临时指示处理到哪里Dim tempRndColor As Integer '临时生成的颜色Dim TABLENAME As String '待处理的表名Dim colorIndex As String '颜色索引名字'表头的背景色HEADERCOLORINDEX = 15colorIndex = 36 '颜色从33开始是比较浅的颜色TABLENAME = "direct_Price"'关闭所有弹出的警告消息Application.DisplayAlerts = False'设置需要处理的单元表Sheets(TABLENAME).Select'取单元表的总列数与总行数cRows = Sheets(TABLENAME).UsedRange.Rows.Count cColumns = Sheets(TABLENAME).UsedRange.Columns.Count '''''选择所有的单元格Range(Cells(1, 1), Cells(cRows, cColumns)).Select'设置该表中所有单元行高为11.25Selection.RowHeight = 11.25'设置该表中所有单元行高为11.25Selection.RowHeight = 11.25'设置所有的边框Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNoneWith Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd With'并且拆分所有的单元格With Selection.MergeCells = False '拆分单格End WithColumns("C:C").SelectSelection.Insert Shift:=xlToRight'删除第一列,注意这里必须先拆分单格，再删除第一列，否则一次就会把合并单元格所在列全部删除Range(Cells(1, 1), Cells(1, 1)).SelectSelection.EntireColumn.Delete'Selection.EntireColumn.Delete'向表头添加一行Rows("1:1").SelectSelection.InsertColumns("A:A").SelectSelection.ColumnWidth = 9.29Columns("B:B").SelectSelection.ColumnWidth = 6.71Columns("C:C").SelectSelection.ColumnWidth = 15.29Columns("D:D").SelectSelection.ColumnWidth = 29.86Columns("E:E").SelectSelection.ColumnWidth = 12.29Columns("F:F").SelectSelection.ColumnWidth = 12.29'''''设定单元格A1:A2'''合并A1:A2单元格Range("A1:A2").Select'将数据写回With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd With'往该单元格中写入Usage_VarActiveCell.FormulaR1C1 = "Price"'设置该单元格字体格式With ActiveCell.Characters(Start:=1, Length:=5).Font .Name = "Arial".FontStyle = "加粗倾斜".Size = 10.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 2End With'单元格设定边框Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNoneWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithSelection.Borders(xlInsideHorizontal).LineStyle = xlNone With Selection.Interior.colorIndex = 5.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'''''设定头两行的内部样式'''''Range("B1:B2").SelectSelection.MergeRange("C1:C2").SelectSelection.MergeRange("D1:D2").SelectSelection.MergeRange("B1:D2").Select'设置头两行行高为11.25Selection.RowHeight = 14.25With Selection.Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContextEnd WithWith Selection.Interior.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithRange("B1:B2").SelectActiveCell.FormulaR1C1 = "Type"With ActiveCell.Characters(Start:=1, Length:=4).Font .Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 5End WithRange("E1:F1").SelectWith Selection.Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 5End WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithWith Selection.Interior.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAutomatic End WithActiveCell.FormulaR1C1 = "Price" Range("E2:F2").Select'设置头两行行高为11.25Selection.RowHeight = 14.25With Selection.Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithWith Selection.Interior.colorIndex = HEADERCOLORINDEX.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'加第一二行边框Range("A1:F2").SelectSelection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd With'去掉第三行的:号'sTempString = Right(Cells(3, 1), Len(Cells(3, 1)) - 3)'ActiveCell.FormulaR1C1 = sTempStringi = 2j = 1'外层循环判断是否都合并完成,这里插入了一行，加1While i <= cRows' i = i + 1Range(Cells(i + 1, j), Cells(i + 1, j)).Select'去掉分类行中的:号If (Len(Cells(i + 1, j)) >= 3) Then''如果是分格的界限If (Left(Cells(i + 1, j), 3) = " : ") ThenRange(Cells(i + 1, j), Cells(i + 1, cColumns)).Select '对第三行进行设定'设置头两行行高为11.25Selection.RowHeight = 18With Selection.Interior.colorIndex = 2.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With'合并前两格'先将其合并With Selection.HorizontalAlignment = xlLeft '靠左对齐.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd With'合并Selection.Merge'对其设定字体风格With Selection.Font.Name = "Arial".FontStyle = "加粗倾斜".Size = 9.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 3End WithWith Selection.HorizontalAlignment = xlLeft.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithsTempString = Right(Cells(i + 1, j), Len(Cells(i + 1, j)) - 3) ActiveCell.FormulaR1C1 = sTempStringi = i + 1End IfEnd Ifi = i + 1'加1后判断是否到了表尾，没有继续合并处理'If (i <= cRows + 1) ThenrowIndex = i'取出Cells(i, j)的内容sTempString = Cells(i, j)'循环判断下一个单元格是否和上一个单元格相等，不是则表示到此该合并While sTempString = Cells(i + 1, j) And i <= cRowsi = i + 1Wend设置第一列'''''跳出循环表示已经到此该将rowIndex 和i行合并Range(Cells(rowIndex, j), Cells(i, j)).SelectSelection.Merge'将原来内容填充进来ActiveCell.FormulaR1C1 = sTempString'设合并后的单元格的边框With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = TrueEnd WithSelection.Font.FontStyle = "加粗"设置第一列结束'''''''设置第二列'''Range(Cells(rowIndex, j + 1), Cells(i, j + 1)).Select'设置字体With Selection.Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 5End WithWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd WithSelection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = 56End WithSelection.Borders(xlInsideHorizontal).LineStyle = xlNone'''''设置第二列结束''''修改原来单元格的数据格式''首先向任一无用的单元格写入数据Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).SelectActiveCell.FormulaR1C1 = "1"'将其格式拷贝Selection.Copy'复制格式Range(Cells(rowIndex, j + 4), Cells(i, cColumns)).SelectSelection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _SkipBlanks:=False, Transpose:=FalseSelection.NumberFormatLocal = "_*#,##0.00000"'清除原来内容Range(Cells(cRows + 2, cColumns), Cells(cRows + 2, cColumns)).SelectSelection.ClearContents设定数据格式完成'''''''统一设置该区域的颜色'''''设置内部填充Range(Cells(rowIndex, j), Cells(i, cColumns)).SelectcolorIndex = colorIndex + 1If colorIndex > 39 ThencolorIndex = 33End IfWith Selection.Interior.colorIndex = colorIndex '颜色.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd With''''统一设置该区域的颜色结束'''''''''设置剩余的列'''Range(Cells(rowIndex, j + 2), Cells(i, cColumns)).Select '设置字体With Selection.Font.Name = "Arial".FontStyle = "常规".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd With'设置第6列Range(Cells(rowIndex, j + 4), Cells(i, j + 5)).Select '设置字体With Selection.Font.Name = "Arial".FontStyle = "常规".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = 3End With'''''设置全部的边框'''Range(Cells(rowIndex, j), Cells(i, cColumns)).Select'设置边框Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideHorizontal)' .LineStyle = xlContinuous.Weight = xlThin' .colorIndex = xlAutomaticEnd WithWendRange(Cells(rowIndex - 1, 1), Cells(rowIndex - 1, cColumns)).Select Selection.MergeCells = FalseRange(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns - 1)).SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd With.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithWith Selection.Interior.colorIndex = 15.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithActiveCell.FormulaR1C1 = "Average"With ActiveCell.Characters(Start:=1, Length:=7).Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithRange(Cells(rowIndex - 1, cColumns), Cells(rowIndex - 1, cColumns)).SelectWith Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.WrapText = True.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlContext.MergeCells = FalseEnd With.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithWith Selection.Interior.colorIndex = 15.Pattern = xlSolid.PatternColorIndex = xlAutomaticEnd WithActiveCell.FormulaR1C1 = "Average"With ActiveCell.Characters(Start:=1, Length:=7).Font.Name = "Arial".FontStyle = "加粗".Size = 8.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlUnderlineStyleNone.colorIndex = xlAutomaticEnd WithRange(Cells(rowIndex - 1, cColumns - 1), Cells(rowIndex - 1, cColumns)).SelectSelection.Borders(xlDiagonalDown).LineStyle = xlNoneSelection.Borders(xlDiagonalUp).LineStyle = xlNoneWith Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeTop).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlEdgeRight).LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous.Weight = xlThin.colorIndex = xlAutomaticEnd WithWith Selection.Borders(xlInsideHorizontal) ' .LineStyle = xlContinuous.Weight = xlThin' .colorIndex = xlAutomaticEnd WithEnd Sub。

ExcelVBA编程实例（150例）主要内容和特点《ExcelVBA编程入门范例》主要是以一些基础而简短的VBA实例来对ExcelV BA中的常用对象及其属性和方法进行讲解，包括应用程序对象、窗口、工作簿、工作表、单元格和单元格区域、图表、数据透视表、形状、控件、菜单和工具栏、帮助助手、格式化操作、文件操作、以及常用方法和函数及技巧等方面的应用示例。

这些例子都比较基础，很容易理解，因而，很容易调试并得以实现，让您通过具体的实例来熟悉ExcelVBA编程。

■ 分16章共14个专题，以具体实例来对大多数常用的ExcelVBA对象进行讲解；■ 一般而言，每个实例都很简短，用来说明使用VBA实现Excel某一功能的操作；■ 各章内容主要是实例，即VBA代码，配以简短的说明，有些例子可能配以必要的图片，以便于理解；■ 您可以对这些实例进行扩充或组合，以实现您想要的功能或更复杂的操作。

VBE编辑器及VBA代码输入和调试的基本知识在学习这些实例的过程中，最好自已动手将它们输入到VBE编辑器中调试运行，来查看它们的结果。

当然，您可以偷赖，将它们复制/粘贴到代码编辑窗口后，进行调试运行。

下面，对VBE编辑器界面进行介绍，并对VBA代码输入和调试的基本知识进行简单的讲解。

激活VBE编辑器一般可以使用以下三种方式来打开VBE编辑器：■ 使用工作表菜单“工具——宏——Visual Basic编辑器”命令，如图00-01所示；■ 在Visual Basic工具栏上，按“Visual Basic编辑器”按钮，如图00-02所示；■ 按Alt+F11组合键。

图00-01：选择菜单“工具——宏——Visual Basic编辑器”命令来打开VBE编辑器图00-02：选择Visual Basic工具栏上的“Visual Basic编辑器”命令按钮来打开VBE编辑器此外，您也可以使用下面三种方式打开VBE编辑器：■ 在任一工作表标签上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问该工作表的代码模块，如图00-03所示；■ 在工作簿窗口左上角的Excel图标上单击鼠标右键，在弹出的菜单中选择“查看代码”，则可进入VBE编辑器访问活动工作簿的ThisWorkbook代码模块，如图00-04所示；■ 选择菜单“工具——宏——宏”命令打开宏对话框，若该工作簿中有宏程序，则单击该对话框中的“编辑”按钮即可进行VBE编辑器代码模块，如图00-05所示。

VBA范例大全目录第1章单元格选择技巧与选区统计1.1 单元格与区域选择技巧实例1 选择A列最后一个非空单元格实例2 基于指定位置的偏移量的选取实例3 选择当前列最大值实例4 选择所有负数单元格实例5 选择工作表已用区域及单元格所在区域实例6 选择数组公式区域实例7 返回单元格合集与交集实例8 选择背景色为红色的单元格实例9 选择字体为兰色之单元格实例10 选择粗线边框之单元格实例11 反向选择工作表实例12 选择单元格区域但排除首行标题实例13 每隔三行选一行实例14 选择奇数列1.2 多表单元格选择实例15 同时选择三个表的B2：B11实例16 选本表以外所有工作表的B2：B11区域实例17 选中名字包含“星期”的工作表的已用区域1.3 对选区进行基本统计实例18 提取选区地址并计数实例19 判断选区隐藏单元格个数实例20 列出隐藏单元格地址实例21 统计选区空白单元格个数实例22 统计选区公式个数实例23 计算已用行列数实例24 统计带批注之单元格个数实例25 统计选区格式为“常规”之单元格个数实例26 分别统计选区文本与字母、数字个数实例27 统计选区中负数个数1.4 本章小结第2章单元格数据处理技巧2.1 选区数字、文本及字母转换实例28 将选择区域公式转化成数值实例29 将当前区域公式转化成数值实例30 将指定区域数字格式转换为文本实例31 自动将小写转化为大写实例32 将英文转为首字母大写2.2 修改选区格式实例33 修改日期格式实例34 将选区零值替换为空实例34 将区域数据改为”万”为单位实例36 将”#”号上标显示实例37 修改任意字符为上标实例38 任意字符添加下划线实例39 任意字符上方添加着重符实例40 用工作表函数对A列数据排序2.3 修改选区数据实例41 多个单元格区域数据互换实例42 填充空白单元格实例43 填充公式实例44 批量填充单元格数据实例45 删除“不采用建议”字符所在行实例46 瞬间删除空白行实例47 瞬间删除空白单元格所在行实例48 瞬间删除选区空格实例49 行列之隐藏与取消实例50 符合三个條件则匯總数据实例51 汇总行列值2.4 控制选区的不重复值实例52 统计字符在选区的重复次数实例53 报告重复数据的地址实例54 检查重复数据重复次数实例55 统计选区不重数据个数实例56 提取列数据之不重复值实例57 提取多列数据不重复值实例58 单列不允许输入重复值实例59 双列控制不重复值实例60 跨工作表控制不重复值2.5 链接功能的使用实例61 单元格链接实例62 工作表链接实例63 删除其它工作表工作簿之数据链接实例64 删除工作表自己添加的网址及MAIL地址链接2.6 批注功能的使用实例65 快捷键添加日期批注并自动缩放实例66 批量添加批注实例67 批量删除批注实例68 将指定列数据添到加批注实例69 添加图片批注实例70 添加个性化批注实例71 批量修改批注实例72 为公式添加标注2.7 合并单元格相关操作实例73 全选合并单元格实例74 将所有合并单元格加上背景实例75 取消所有合并单元格之合并实例76 取得合并单元格的首个和末尾地址实例77 合并数据并居中实例78 合并数据并粘贴实例79 批量合并单元格实例80 恢复合并实例81 取得合并单元格数目实例82 报告合并单元格地址实例83 对所有合并单元格添加批注并注示序数实例84 将已用区域合并取消并让空白单元格等于原合并值2.8 数据查询与替换实例85 查找单价实例86 多表成绩搜索实例87 电话簿查询实例88 双循环工号查询实例89 将工作表中“PC”批量替换成电脑实例90 将所有工作表中成绩大于60者考分替换成“合格”2.9 处理名称实例91 对区域及图片、图表命名实例92 显示与隐藏名称实例93 将包含指定名称的对象隐藏实例94 利用名称动态求和2.10 其它应用实例95 发邮件及开启网址实例96 单元格数据放大实例97 产生不重复随机数实例98 将含有分割符之数据转为下拉列表实例99 生成带圈之编号实例100 单元格动态显示时间实例101 根据指定最大值和最小值求所有数据之和实例102 利用勾股定理求弦长实例103 输入三边长求三角形面积实例104 指定时间出现“会议时间到”的提示2.11 本章小结第3章条件格式及数据突现方式3.1 条件格式其它数据突现方式实例105 用黄色字体突出显示当前行实例106 黑体字体显示男生成绩实例107 灰色底纹显示优异成绩之成员实例108 对区域中最大值添加下划线实例109 对区域中超过平均值之数据加粗倾斜实例110 用彩色条标示区域值的大小实例111 列举所有颜色与索引值实例112 将重复值加上虚框实例113 圈释目标3.2 管理条件格式规则实例114 在已有条件格式区域增加条件实例115 删除区域的条件格式实例116 删除工作簿中所有的条件格式实例117 提升第三个条件优先为一3.3 本章小结第4章排序4.1 对数值和文本排序实例118 对选区数值以升序排序实例119 对选区文本以字母顺序升序排序实例120 对选区文本以笔划顺序降序排序实例121 对选区数据区分大小写排序实例122 对选区区分大小写对文本排序4.2 按颜色排序实例123 按单元格背景颜色对当前列排序实例124 按单元格字体颜色对当前列排序实例125 按单元格字体颜色扩展区域排序且有标题4.3 多条件排序实例126 双条件排序首列数值升序次列笔划降序实例127 背景色和拼音单列双条件排序4.4 本章小结第5章数据筛选5.1 单条件数据筛选实例128 筛选大于10之数据实例129 筛选小于等于300之数据实例130 筛选高于平均值之数据实例131 筛选前五个最大值实例132 筛选不包含目标之数据实例133 按颜色筛选数据5.2 多条件数据筛选实例134 排除2和12之数据实例135 排除小于5的数据但等于1时例外实例136 筛选姓曲、姓名为三个字且不包含飞之数据实例137 筛选最后一个字符不为仙且长度为2之数据5.3 去除筛选实例138 去除区域中的筛选状态实例139 去除单列筛选状态5.4 本章总结6.1 图形的基本操作实例140 生成椭圆图形并双色渐变填充图形背景实例141 修改图形边框色与宽度实例142 旋转图形实例143 图形的批量删除实例144 隐藏与显示图形实例145 移动图片并设置其填充图形背景实例146 将图片导出至硬盘实例147 将单元格区域转换成图片实例148 检测单元格是否被图片覆盖6.2 使用艺术字实例149 插入艺术字实例150 修改艺术字外形及填充色6.3 图形的综合运用实例151 将所有图形垂直与水平翻转实例152 复制签名实例153 动态旋转图形实例154 制作风扇实例155 取得指定文件夹下图片名称实例156 批量调整片适合单元格大小实例157 旋转艺术字实例158 让图片跟随鼠标实例159 根据名称显示图形实例160 批量修改复选框的值实例161 按姓名插入图片6.4 图形在窗体中的运用实例162 将工作表填充至窗体实例163 加载窗体图片实例164 窗体中预览图片实例165 随机更换图片6.5 本章小结7.1 编辑图表实例166 显示与隐藏标签、网格实例167 修改图表标题与座标轴标题实例168 用图片填充背景墙实例169 动态显示鼠标所在列数据之图表实例170 利用动态名称运态显示图表内容实例171 利用图表制作进度条实例172 批量修改数据标签实例173 随心所欲显示图表类型7.2 图表至图片之转化实例174 将图片转换成图片实例175 让图表显示在窗体中并双击更新7.3 本章小结第8章控制工作表8.1 工作表的建立、删除、改名与排序实例176 建新工作表前检查是否具有同名工作表实例177 批量新建工作表并以日期命名实例178 禁止新增工作表实例179 本工作簿及其它工作簿间移动工作表实例180 启用宏方可进入指定工作表实例181 禁止进入某工作表实例182 禁止进入指定工作表以外的工作表实例183 判断工作簿中是否包含指定工作表实例184 删除汇总表以外的所有分表实例185 删除工作簿中所有空白工作表实例186 禁止修改工作表名实例187 禁止另存为别的名称实例188 恢复所有工作表的默认名称实例189 工作表排序实例190 语音提示工作表名8.2 保存与备份工作表实例191 定时保存实例192 保存时自动备份文件8.3 工作表显示与隐藏实例193 工作表显示与隐藏实例194 显示所有的被隐藏的工作表实例195 根据分辨率调整工作表视图8.4 打开工作表实例196 后台打开EXCEL文件实例197 调用打开对话框实例198 向其它工作表实例199 打开数据库实例200 导入文本文件到工作表实例201 导出工作表到TXT实例202 调用最近打开的第三个文件实例203 每次打开都进入同一工作表8.5 工作表目录实例204 建立菜单式工作表目录实例205 在工作表建立目录实例206 在单个单元格建立工作表目录实例207 返回工作表目录8.6 用工作表播放音乐实例208 工作表播放MP3实例209 工作簿背景音乐8.7 工作表事件的运用实例210 右键查看输入选项实例211 激活工作表时提示本工作表是否空白实例212 双击提示现在的时间实例213 工作表事件在人事管理中的运用添加一个功能：滚动显示工作表8.8 本章小结第9章多工作表操作9.1 多表数据运算与透视实例215 将数据追加到分表实例216 多表求和实例217 建立多表之数据透视一实例218 建立多表之数据透视二9.2 工作表拆分实例219 当前工作表拆分到多表(乱序)实例220 当前工作表拆分到多表(有序)实例221 将多工作表拆分成同路径下多工作簿9.3 工作表合并实例222 多表数据合并实例223 多工作簿合并到本工作簿实例224 多工作簿合并到当前工作表9.4 本章小结第10章工作表页面设置与打印10.1 页面设计实例225 取得当前工作表页数实例226 页面设置（设定打印区域、设置页边距及居中方式/改缩放比例及打印方向）实例227 按条件插入分页实例228 将单元格数据转化为页脚实例229 分页小计10.2 打印实例230 一次打印多个工作表实例231 打印当前光标所在页实例232 禁止打印当前工作表10.3 本章小结第11章工作簿安全处理11.1 文件加锁实例233 指定用户名方可开启本工作簿实例234 本电脑方可打开本工作簿实例235 工作表反向加密实例236 不用密码锁定编辑区域实例237 锁定鼠标移动范围实例238 批量保护工作表11.1 文件与代码删除方式实例239 文件定时自杀实例240 文件只能使用三次实例241 VBA代码自杀实例242 删除“中国”则工作簿自杀11.3 本章小结第12章文件与目录12.1 创建与管理文件实例243 批量创建工作簿实例244 文件复制并命名实例245 修改文件创建时间实例246 生成桌面快捷方式12.2 获取文件相关属性实例247 判断文件大小及文件修改时间实例248 取得当前文件路径实例249 判断文件夹中指定文件是否存在实例250 列举指定文件夹下所有EXCEL文件实例251 报告指定文件夹下隐藏文件个数12.3 管理文件夹实例252 查看与修改目录属性实例253 列出D盘所有目录实例254 计算驱动器数目实例255 建立与删除目录实例256 打开指定目录实例257 删除空文件夹实例258 获取磁盘卷标和可用空间12.4 本章小结第13章窗体与控件13.1 窗体基本属性实例259 枚举窗体属性实例260 窗体基本属性设置实例261 窗体之装载与卸载13.2 修改窗体显示模式实例262 窗体位置在屏幕中央实例263 窗体全屏显示实例264 为窗体添加最大化简小化按钮实例265 为窗体添加图标实例266 去除窗体边框实例267 将窗体置于上层实例268 去除与复位窗体的关闭按钮实例269 让窗体在指定时间逐渐退出13.3 窗体事件的运用实例270 运行窗体时隐藏程序实例271 单击修改背景双击修改名字实例272 鼠标移过时隐藏图片控件实例273 右击窗体循环显示艺术字实例274 移动窗体时报告窗体座标实例275 将ALT+F4关闭窗体改为ESC键实例276 关闭窗体时报窗体中控件数目实例277 左键拖动窗体实例278 移动窗体的标签并显示标签座标13.4 文本框实例279 控制文本框的层次实例280 设置文本框的密码样式实例281 限制用户输入数字实例282 批量锁定文本框实例283 文本框输入完毕后自行执行命令实例284 利用微调框控制文本框数字实例285 文本框向工作表添加数据并检测重复性13.5 列表框实例286 列表框数据之导入与导出实例287 列表框追加数据实例288 两个列表框之间的内容转移实例299 动态数据列表框使用实例290 利用列表框查询成绩实例291 用列表框控件打造增强性数据有效性13.6 组合框实例292 用组合框快速输入数据实例293 添加不重复值到组合框13.7 网页控件实例294 窗体中调用网页实例295 窗体创建网页且实例296 窗体中使用滚动文字实例297 窗体中显示GIF动13.8 FLASH控件实例298 窗体中播放FLASH实例299 控制播放FLASH13.9 图片控件实例300 图片控件的缩放与排列实例301 用复合框控件图片显示实例302 让图片循环滚动实例303 用图像控件打造动态按钮13.10 窗体与控件的综合运用实例304 利用日历控件输入日期实例305 一个按钮执行两个不同程序实例306 让控件适合窗体的缩放实例307 设计验证登录框实例308 制作百叶窗效果的欢迎画面实例309 利用圆窗体与网页打造时钟13.11 本章小结第14章自定义函数14.1 数值运算类实例310 按字体色求和实例311 分数型数据求和实例312 前N位和实例313 按业务量和工龄计算提成实例314 N次方和实例315 去首尾求平均实例316 根据边长求三角形周长和面积实例317 对指定范围求和与求积14.2 引用类实例318 引用区域唯一值实例319 引用单元格格式实例320 引用区域中非空值实例321 枚举工作表名实例322 返回列号对应之英文字母14.3 文本处理类实例323 按分割符取数实例324 分离数字实例325 增强型字符连接函数实例326 从右向左查字符在某字符串的位置实例327 返回单元格之批注实例328 根据身份证号返回性别实例329 大写14.3 本章小结第15章设制界面与菜单15.1 定义EXCEL显示方式实例330 屏弊EXCEL部分显示功能（网络线/标尺/滚动条）实例331 自定义状态栏进度条实例332 增强型状态栏实例333 状态栏滚动显示日期15.2 定义功能区菜单实例334 枚举所有菜单实例335 在功能区建立自己的工具按钮实例336 添加工作表标签菜单实例337 自定义按钮图标实例338 生成一二级菜单(关机/重启/锁屏)实例339 禁用与隐藏自定义菜单项实例340 生成图表专用菜单15.3 定义快捷键实例341 禁用与启用快捷键实例342 重定义快捷键（禁用快捷键）实例343 给宏指定快捷方式15.4 定义右键菜单实例344 禁用右键前三个选项实例345 在右键中建立工作表目录实例346 为右键赋与新功能——选区缩放实例347 添加“返回首页”功能于右键15.5本章小结第16章加载宏16.1 将工作簿转为加载宏实例348 手工转换工作簿为加载宏实例349 用代码转换工作簿为加载宏16.2 加载宏加载与卸载实例350 加载与卸载加载宏16.3 本章小结第17章综合实例运用17.1 多功能通讯簿17.1.1 系统内容说明17.1.2 界面设计与系统结构17.1.3 关键技术运用17.1.4 程序代码分析16.2人事资料管理17.2.1 系统内容说明17.2.2 界面设计与系统结构17.2.3 关键技术运用17.2.4 程序代码分析17.3本章小结附录A VBA常用函数附录B VBA方法列表网上售书地址：当当网（支持货到付款）/product.aspx?product_id=20170920卓越网（支持货到付款）/mn/detailApp?qid=1206666629&ref=SR&sr=1-1&uid=168-4 015694-8839453&prodid=bkbk821275小书角/auction/item_detail-0db1-560eb15263301d3906484027f1f 46163.jhtml/auction/item_detail-0db2-aacc31b5d9fe9f0783d97d8e036 0ce02.jhtml淘书工社/auction/item_detail-0db2-e355e791faba6bba6780c15aff8f bfbc.jhtml出版社网/bookshop/bookinfo.asp?bookcode=TP057790%20&booktyp e=new中国互动网/39292中国图书网/2723817.htm金桥书城/product/545290.html王府井书店/list.asp?id=712105779读书网/book/11858361/广州购书中心/search/view.jsp?proID=998168新华成都在线/content/1-100840647.htm博库书城/kgsm/ts/2008/03/31/1288960.shtml?。

43个典型ExcelVBA实例目录例1.九九乘法表（Print方法的应用） (3)例2 输入个人信息（Inputbox函数的应用） (3)例3 退出确认（Msgbox函数的应用） (5)例4 突出显示不及格学生 (7)例5 从身份证号码中提取性别 (8)例6 评定成绩等级 (9)例7 计算个人所得税 (11)例8 密码验证 (13)例9 求最小公倍数和最大公约数 (15)例10 输出ASCII码表 (16)例11 计算选中区域数值之和 (17)例12 换零钱法（多重循环） (18)例13 数据排序 (21)例14 彩票幸运号码 (22)例15 用数组填充单元格区域 (24)例16 判断单元格是否包含公式 (25)例17 自动填充公式 (26)例18 锁定和隐藏公式 (28)例19 将单元格公式转换为数值 (29)例20 删除所有公式 (29)例21 用VBA表示数组公式 (30)数据查询 (31)例22 查找指定的值 (31)例23 带格式查找 (33)例24 查找上一个/下一个数据 (34)例25 代码转换 (36)例26 模糊查询 (37)例27 网上查询快件信息 (38)例28 查询基金信息 (40)例29 查询手机所在地 (41)例30 使用字典查询 (43)数据排序 (45)例31 用VBA代码排序 (45)例32 乱序排序 (46)例33 自定义序列排序 (47)例34 多关键字排序 (49)例35 输入数据自动排序 (50)例36 数组排序 (51)例37 使用Small和Large函数排序 (52)例38 使用RANK函数排序 (54)例39 姓名按笔画排序 (56)例40 用VBA进行简单筛选 (59)例41 用VBA进行高级筛选 (61)例42 筛选非重复值 (62)例43 取消筛选 (63)：例1.九九乘法表（Print方法的应用）1．案例说明在早期的Basic版本中，程序运行结果主要依靠Print语句输出到终端。

43个典型ExcelVBA实例目录例1.九九乘法表（Print方法的应用） (3)例2 输入个人信息（Inputbox函数的应用） (3)例3 退出确认（Msgbox函数的应用） (5)例4 突出显示不及格学生 (7)例5 从身份证号码中提取性别 (8)例6 评定成绩等级 (9)例7 计算个人所得税 (11)例8 密码验证 (13)例9 求最小公倍数和最大公约数 (15)例10 输出ASCII码表 (16)例11 计算选中区域数值之和 (17)例12 换零钱法（多重循环） (18)例13 数据排序 (21)例14 彩票幸运号码 (22)例15 用数组填充单元格区域 (24)例16 判断单元格是否包含公式 (25)例17 自动填充公式 (26)例18 锁定和隐藏公式 (28)例19 将单元格公式转换为数值 (29)例20 删除所有公式 (29)例21 用VBA表示数组公式 (30)数据查询 (31)例22 查找指定的值 (31)例23 带格式查找 (33)例24 查找上一个/下一个数据 (34)例25 代码转换 (36)例26 模糊查询 (37)例27 网上查询快件信息 (38)例28 查询基金信息 (40)例29 查询手机所在地 (41)例30 使用字典查询 (43)数据排序 (45)例31 用VBA代码排序 (45)例32 乱序排序 (46)例33 自定义序列排序 (47)例34 多关键字排序 (49)例35 输入数据自动排序 (50)例36 数组排序 (51)例37 使用Small和Large函数排序 (52)例38 使用RANK函数排序 (54)例39 姓名按笔画排序 (56)例40 用VBA进行简单筛选 (59)例41 用VBA进行高级筛选 (61)例42 筛选非重复值 (62)例43 取消筛选 (63)：例1.九九乘法表（Print方法的应用）1．案例说明在早期的Basic版本中，程序运行结果主要依靠Print语句输出到终端。

完全手册Excel VBA典型实例大全：通过368个例子掌握目录第1章宏的应用技巧宏是一个VBA程序，通过宏可以完成枯燥的、频繁的重复性工作。

本章的实例分别介绍在Excel 2019、Excel 2019中录制宏、使用Visual Basic代码创建宏的方法，最后还以实例演示运行宏和编辑宏的方法。

1.1 创建宏 1例001 在Excel 2019中录制宏1例002 打开Excel 2019的录制宏功能 3例003 在Excel 2019中录制宏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 编程时，也需要频繁地引用单元格区域。

Excel VBA 常用代码50例001。

用命令按扭打印一个sheet1中B2:M30区域中的内容?我想在Sheet2中制件一个命令按扭, 打印表Sheet1中的[B2:M30] 区域中的内容?解答：可以将打印区域设为b2：m30，然后打印，如：sheets("sheet1").printarea="b2:m30"sheets("sheet1").printout随手写的，你可以试试看。

最简单的方法是：你先录制宏，在录制宏过程中，跑到页面设置里面，把打印范围设置到你想要的范围。

然后退出，停止录制宏，你就可以得到一些代码！002。

能否对一列中的文字统一去掉最后一个字?这些文字不统一,有些字数多,有些字数少。

如何处理?我用{"&-}不行解答：=REPLACE(A1,LEN(A1),1," ")(在过渡列进行)003.能否根据单元格数值自动标记序号？各位大佬，一工作表有两列，“序号”及“金额”，能否将金额不等于0的行自动标上序号呢？如无现成的函数，应怎样设置？解答：Dim xuhao As Integerxuhao = 1Range("b2").SelectDo While Selection <> ""If Selection <> 0 ThenActiveCell.Previous.Value = xuhaoxuhao = xuhao + 1End IfActiveCell.Offset(1, 0).Range("a1").SelectLoop004.求教自定义函数查询了一些自定义函数的例子都是单变量的。

自定义函数能否建立“(As Range) As Interger”的函数，应该可以的，请各位大师赐教！请以“∑x2”为例，万分感谢！(该用"For Each ...Next"，就是还不知道如何引用Range中的每个值，请高手指点。

43个典型ExcelVBA实例目录例1.九九乘法表（Print方法的应用） (3)例2 输入个人信息（Inputbox函数的应用） (3)例3 退出确认（Msgbox函数的应用） (5)例4 突出显示不及格学生 (7)例5 从身份证号码中提取性别 (8)例6 评定成绩等级 (9)例7 计算个人所得税 (11)例8 密码验证 (13)例9 求最小公倍数和最大公约数 (15)例10 输出ASCII码表 (16)例11 计算选中区域数值之和 (17)例12 换零钱法（多重循环） (18)例13 数据排序 (21)例14 彩票幸运号码 (22)例15 用数组填充单元格区域 (24)例16 判断单元格是否包含公式 (25)例17 自动填充公式 (26)例18 锁定和隐藏公式 (28)例19 将单元格公式转换为数值 (29)例20 删除所有公式 (29)例21 用VBA表示数组公式 (30)数据查询 (31)例22 查找指定的值 (31)例23 带格式查找 (33)例24 查找上一个/下一个数据 (34)例25 代码转换 (36)例26 模糊查询 (37)例27 网上查询快件信息 (38)例28 查询基金信息 (40)例29 查询手机所在地 (41)例30 使用字典查询 (43)数据排序 (45)例31 用VBA代码排序 (45)例32 乱序排序 (46)例33 自定义序列排序 (47)例34 多关键字排序 (49)例35 输入数据自动排序 (50)例36 数组排序 (51)例37 使用Small和Large函数排序 (52)例38 使用RANK函数排序 (54)例39 姓名按笔画排序 (56)例40 用VBA进行简单筛选 (59)例41 用VBA进行高级筛选 (61)例42 筛选非重复值 (62)例43 取消筛选 (63)：例1.九九乘法表（Print方法的应用）1．案例说明在早期的Basic版本中，程序运行结果主要依靠Print语句输出到终端。