excel vba 示例1

1、将excel汇总好的表，按字段拆分为多sheet的情况：如下图：代码如下：Sub cfs()Dim GSArr() As String '公司名称清单Dim Rca As Integer 'A列数据行数Dim i As IntegerDim Sn As StringSn = Rca = Columns("A:A").End(xlDown).Row ‘按第A列数据拆分，且第一行无合并单元格ReDim GSArr(1 To 1)GSArr(1) = Cells(2, 1)For i = 3 To RcaIf IsError(Application.Match(Cells(i, 1), GSArr, 0)) ThenReDim Preserve GSArr(1 To UBound(GSArr) + 1)GSArr(UBound(GSArr)) = Cells(i, 1)End IfNextIf ActiveSheet.AutoFilterMode = False ThenRows("1:1").AutoFilterElseIf ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllDataEnd IfFor i = 1 To UBound(GSArr)ActiveSheet.Cells.AutoFilter Field:=1, Criteria1:=GSArr(i)Sheets.Add After:=Sheets(Sheets.Count) = GSArr(i)Sheets(Sn).Cells.Copy ActiveSheet.CellsSheets(Sn).ActivateNextActiveSheet.Cells.AutoFilterEnd Sub2、将汇总的好的EXCEL表按字段拆分为多个工作薄代码如下：Sub CFGZB()Dim myRange As VariantDim myArrayDim titleRange As RangeDim title As StringDim columnNum As IntegermyRange = Application.InputBox(prompt:="请选择标题行：", Type:=8)myArray = WorksheetFunction.Transpose(myRange)Set titleRange = Application.InputBox(prompt:="请选择拆分的表头，必须是第一行，且为一个单元格，如：“姓名”", Type:=8)title = titleRange.ValuecolumnNum = titleRange.ColumnApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseDim i&, Myr&, Arr, num&Dim d, kFor i = Sheets.Count To 1 Step -1If Sheets(i).Name <> "数据源" Then ‘待拆分的表sheet名为：数据源Sheets(i).DeleteEnd IfNext iSet d = CreateObject("Scripting.Dictionary")Myr = Worksheets("数据源").UsedRange.Rows.CountArr = Worksheets("数据源").Range(Cells(2, columnNum), Cells(Myr, columnNum))For i = 1 To UBound(Arr)d(Arr(i, 1)) = ""Nextk = d.keysFor i = 0 To UBound(k)Set conn = CreateObject("adodb.connection")conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName‘2013版连接字符Sql = "select * from [数据源$] where " & title & " = '" & k(i) & "'"Dim Nowbook As WorkbookSet Nowbook = Workbooks.AddWith NowbookWith .Sheets(1).Name = k(i)For num = 1 To UBound(myArray).Cells(1, num) = myArray(num, 1)Next num.Range("A2").CopyFromRecordset conn.Execute(Sql)End WithEnd WithThisWorkbook.ActivateSheets(1).Cells.SelectSelection.CopyWorkbooks().ActivateActiveSheet.Cells.SelectSelection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseApplication.CutCopyMode = FalseNowbook.SaveAs ThisWorkbook.Path & "\" & k(i)Nowbook.Close TrueSet Nowbook = NothingNext iconn.CloseSet conn = NothingApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub3、将含有多sheet的一个工作表，按sheet名拆分为工作表代码如下：Private Sub 分拆工作表()Dim sht As WorksheetDim MyBook As WorkbookSet MyBook = ActiveWorkbookFor Each sht In MyBook.Sheetssht.CopyActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & , FileFormat:=xlNormal '将工作簿另存为EXCEL默认格式ActiveWorkbook.CloseNextMsgBox "文件已经被分拆完毕!"End Sub4,、将多个工作薄合并为一个多sheet的工作薄代码如下：Sub Books2Sheets()'定义对话框变量Dim fd As FileDialogSet fd=Application.FileDialog(msoFileDialogFilePicker)'新建一个工作簿Dim newwb As WorkbookSet newwb=Workbooks.AddWith fdIf.Show=-1 Then'定义单个文件变量Dim vrtSelectedItem As Variant'定义循环量Dim i As Integeri=1'开始文件检索For Each vrtSelectedItem In.SelectedItems'打开被合并工作簿Dim tempwb As WorkbookSet tempwb=Workbooks.Open(vrtSelectedItem)'复制工作表tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)'把新工作簿的工作表名字改成被复制工作簿文件名，这儿应用于xls文件，即Excel97-2003的文件，如果是Excel2007，需要改成xlsxnewwb.Worksheets(i).Name=VBA.Replace(,".xls","")'关闭被合并工作簿tempwb.Close SaveChanges:=Falsei=i+1Next vrtSelectedItemEnd IfEnd WithSet fd=NothingEnd Sub5、将含有多个sheet的工作表内容信息汇总至一个sheet中Sub Combine()Dim J As IntegerOn Error Resume NextSheets(1).SelectWorksheets.AddSheets(1).Name = "Combined"Sheets(2).ActivateRange("A1").EntireRow.SelectSelection.Copy Destination:=Sheets(1).Range("A1")For J = 2 To Sheets.CountSheets(J).ActivateRange("A1").SelectSelection.CurrentRegion.SelectSelection.Offset(1, 0).Resize(Selection.Rows.Count - 1).SelectSelection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)NextEnd Sub。

excel vba常用实例一、VBA在Excel中的应用实例1. 对单元格的操作● 定义并使用变量：使用变量来对某些单元格或变量的初始值、更改值等进行管理处理。

● 修改单元格属性：如居中，自动换行，字体大小等属性的更改，增强Excel 表格的易读性。

● 遍历所有表格：便于进行元格查找、值拷贝、内容整理等操作，提高操作效率。

2.公式和函数的操作● 编写适用于某些表格或公式的新函数：简化Excel的计算过程，减少公式的复杂性，提高效率。

● 获取公式结果：某些公式计算结果可以通过VBA来获取，并可以用来更新表格里的内容，依据该结果进行二次计算。

● 使用提示性函数：函数名或参数可以通过提示性幕进行输入，完美结合了两者，更方便Excel表格的操作。

3.使用控件● 插入控件：通过VBA插入对话框，指示标、选项按钮等可视化控件可以十分容易地更新Excel表格。

● 修改控件属性：可以通过控件的属性，如大小、位置、文本内容等属性进行调整，为表格添加贴心的交互。

● 事件驱动控件：如在控件上添加拖拽和双击事件，可以动态管理和更新控件的属性。

4. 其它实例● VBA批量更改内容：可以快速替换所有与某个字符串内容相关的单元格，或者将每一行都更新一次，提高更新效率。

● 删除无用页：通过VBA来快速删除包含特定内容的页，比如显示错误的页等等，大大简化整个变更过程。

● 文件保存：可以用VBA设计程序，在每次保存时自动备份文件，防止意外数据丢失。

● 向外部发送email：利用VBA，可以在特定时间自动发送email给目标账号，在表格变更时自动发出通知。

以上就是VBA在Excel中的应用实例，能够为Excel办公操作更新更多效率，添加一些额外的功能，大大提升Excel的能力。

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函数实用经典案例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、打开显示登录窗体代码打开隐藏表格，显示登录窗体private Sub Workbook_open()Application.Visible = falseUserForm1.Showend Sub2、固定账号、密码登录窗体设置（1）制作窗体（2）登录验证Private Sub CommandButton1_Click() If TextBox1 = "admin" ThenIf TextBox2 <> 123 ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功”"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub（3）退出按钮Private Sub CommandButton2_Click() Unload MeThisWorkbook.CloseEnd Sub(4)打开注册窗体Private Sub CommandButton3_Click() UserForm2.ShowEnd Sub（5）唯一关闭代码Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> 1 Then Cancel = TrueEnd Sub3、注册账号（1）制作注册账号窗体（2）注册代码Private Sub CommandButton1_Click()Dim zh As Range, zt As RangeIf TextBox1 = "" Then MsgBox "未填入账户": Exit SubIf TextBox2 <> TextBox3 Then MsgBox "密码不一致": Exit SubSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1)If zh Is Nothing ThenSet zt = Sheets("注册").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) zt = TextBox1.Textzt.Offset(0, 1) = TextBox2.Textzt.Offset(0, 2) = NowMsgBox "注册成功"Unload MeElseMsgBox "账号已经存在，请更换其他账号"End IfEnd Sub4、查找筛选代码Private Sub TextBox1_Change()If Len(TextBox1.Value) = 0 ThenSheet1.AutoFilterMode = FalseElseIf Sheet1.AutoFilterMode = True ThenSheet1.AutoFilterMode = FalseEnd IfSheet1.Range("B7:P" & Rows.Count).AutoFilter _field:=4, Criteria1:="*" & TextBox1.Value & "*"End IfEnd Sub5、多账号密码验证代码Private Sub CommandButton1_Click()If Len(TextBox1) = 0 Then MsgBox "未输入账号": Exit SubDim zh As RangeSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1) If Not zh Is Nothing ThenIf TextBox2.Text <> zh.Offset(0, 1) ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub6、默认打开第一个工作表Private Sub Workbook_Open()Sheet1.ActivateEnd Sub7、退出保存工作表Private Sub Workbook_BeforeClose(Cancel As Boolean) ThisWorkbook.SaveEnd 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所示。

ExcelVBA解读（81）：工作表事件示例本文再列举一些示例，以加深对工作表事件的理解，方便应用。

示例1：阻止用户修改指定单元格区域的数据当用户修改工作表中指定单元格区域的数据时，给出提示信息并改回为原数据。

代码如下：Dim dataPrivate Sub Worksheet_Change(ByValTarget As Range)If Not Intersect(Target, Range('A1:C3')) Is Nothing ThenMsgBox '该区域数据重要,请不要修改!'Application.EnableEvents = FalseTarget.Value = dataApplication.EnableEvents = TrueEnd IfEnd SubPrivate Sub Worksheet_SelectionChange(ByValTarget As Range)data = Target.ValueEnd Sub运行效果如图1所示。

图1示例2：让不同的工作表有不同的快捷菜单在工作表“完美Excel”中，单击右键会出现属于该工作表的快捷菜单，同样，在工作表“Data”中单击右键也会出现属于该工作表的快捷菜单。

如下图2所示。

图2实现上述效果的代码如下。

在“完美Excel”工作表代码模块的BeforeRightClick事件中，输入下面的代码：Private SubWorksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Dim cmb_excelperfect As CommandBarSet cmb_excelperfect = CreateSubMenu('完美Excel')Cancel = Truecmb_excelperfect.ShowPopupEnd Sub在“Data”工作表代码模块的BeforeRightClick事件中，输入相似的代码：Private SubWorksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)Dim cmb_data As CommandBarSet cmb_data = CreateSubMenu('数据处理')Cancel = Truecmb_data.ShowPopupEnd Sub插入一个标准模块，并输入下面的代码：示例3：双击单元格时显示输入框在双击工作表第1列中的单元格时，会显示下图3所示的自定义输入框。

收藏41个Excelvba实例汇总（附赠VBA教程）用过Excel的朋友肯定会遇到各种繁琐的数据处理问题，其实很多时候可以借助VBA一键实现N多复杂、繁琐的操作，大大解放你的双手，提高效率。

永恒君陆陆续续一共分享了VBA的实例共41个，另外还有若干个小的技巧实例。

需要的可以点击这里付费获取！！这里把这些实例再分类整理一下，方便以后的查询和使用，大致分类如下：单元格操作实例（1）- 批量制作工资表头实例（5）- 快速合并n多个相同值的单元格实例（9）- 批量插入、删除表格中的空行实例（11）- 拆分单元格并自动填充实例（12）- 如何合并多个单元格而不丢失单元格的数据？实例（13）- 自动生成序号、一键排版（列宽、行高自适应等）实例（29）–快速实现合并单元格的填充工作表（簿）操作实例（2）- 批量将工作表拆分为单独文件实例（3）- 多个工作簿批量合并实例（4）- 根据已有名称，批量新建表格实例（7）- 一键批量打印工作簿实例（30）–为多个sheets创建目录和超链接数据汇总实例（6）- 一键汇总多个sheet数据到总表实例(19) –一键汇总不完全相同的sheet到总表数据提取实例（8）- 利用正则表达式进行定向提取实例（10）- 统计同一列中出现次数并标注实例（14）- 依据指定单元格的值，复制并插入相同数量的行实例（15）- 按指定字段一键筛选并取最低价记录实例 (16) –按指定字段分类批量提取内容实例 (17) –遍历多个工作簿并提取内容到总表实例(18) –一键将单列长数据平均拆成多列实例(20) –一键填充每月员工拜访地区实例（22）–一键筛选其他工作表或工作簿的数据实例（24）–新股（债）中签一键批量查询实例（27）–一键按列分类并保存单独文件实例（34）–快速匹配出名称不完全相同的数据，vlookup都做不到实例（36）–一键提取网页中的表格数据实例（37）–快速提取手机号及归属地word操作实例（23）–一键批量提取word表格内容实例（26）–一键批量提取word文字内容实例（28）–批量生成word报告实例（33）–一键提取word中加粗文字数据抓取实例（39）- 一键快速查询基金信息、基金净值实例（40）- 一键快速查询基金代码实例（41）- 一键批量查询汉字拼音、部首、笔画等信息其他实例（25）–班级随机点名并播放实例（21）–如何快速准确录入数据实例（31）- 为VBA代码自定义快捷键实例（35）- 一键批量ppt转pdf实例（38）- 批量插入图片并完美匹配单元格大小另外，为了帮助大家更好的理解，永恒君又重新整理了几套关于VBA的视频教程，一并分享给大家。

高级编程EXCEL的VBA应用实例在 Excel 中使用 VBA 编程可以极大地提高工作效率和数据处理能力。

本文将介绍几个高级的 VBA 应用实例，帮助读者更好地掌握Excel 的编程技巧。

VBA（Visual Basic for Applications）是一种专门为 Microsoft Office 软件开发的编程语言，可以通过编写宏代码实现一些自动化操作和功能扩展。

下面我们将通过几个实例来说明 VBA 在 Excel 中的应用。

实例一：自动填充数据假设我们有一个订单表，需要根据已有的数据填充一些重复的信息。

这时候可以使用 VBA 的自动填充功能来实现。

首先打开 Excel 文件，按下 ALT + F11 进入 VBA 编辑器，然后在“项目资源管理器”中选择该工作簿，右键点击“插入”，再选择“模块”，进入新建的模块中编写以下代码：```vbaSub AutoFillData()Dim LastRow As LongLastRow = Range("A" & Rows.count).End(xlUp).RowRange("B2:B" & LastRow).Value = Range("B1").ValueEnd Sub```保存并退出 VBA 编辑器，然后在 Excel 表格中按下 ALT + F8，选择刚才编写的宏并运行。

这样，B 列的数据将自动填充为 B1 单元格的内容。

实例二：自定义函数有时候我们需要进行一些特殊的计算或数据处理，而 Excel 内置的函数无法满足需求。

这时候可以借助 VBA 编写自定义函数。

同样进入VBA 编辑器，创建一个新的模块，编写以下代码：```vbaFunction ConcatenateText(ByVal Text1 As String, ByVal Text2 As String) As StringConcatenateText = Text1 & " " & Text2End Function```保存并退出 VBA 编辑器，然后在 Excel 表格中可以使用"=ConcatenateText(A1, B1)" 函数将 A1 和 B1 单元格的内容拼接在一起。

VBA编程实例第九章工作表排序本章只有一个范例文件，主要功能对活动工作簿中所有工作表进行排序。

算法说明:1、统计活动工作簿中工作表的数量WsCount=Activeworkbook.worksheets.count2、定义一个一维数组a(1 to wscount)主要用来存放活动工作簿中所有工作表名称字符串 3、利用for each ws in activeworkbook.worksheets 循环将活动工作簿中所有数量赋值给一维数组 4、利用冒泡法对数组进行排序(源文件对排序单独写了一个过程)5、利用worksheets的move方法以及sheets(i)(他代表工作簿中从左到右第i张工作表)移动工作表代码:Sub SortSheet()Dim WsCount As IntegerDim WsArray() As StringDim Ws As WorksheetOn Error Resume NextWsCount = ActiveWorkbook.Worksheets.Count ReDim WsArray(1 To WsCount) If ActiveWorkbook.ProtectStructure ThenMsgBox & " 被保护，不能进行排序，请解除保护后排序", _vbCritical, "不能排序工作表"Exit SubEnd IfFor Each Ws In ActiveWorkbook.Worksheetst = t + 1WsArray(t) = Next Ws'对数组进行排序For i = 1 To UBound(WsArray) - 1For j = i + 1 To UBound(WsArray)If WsArray(i) > WsArray(j) Thent = WsArray(i)WsArray(i) = WsArray(j)WsArray(j) = tEnd IfNext jNext i'利用Move方法以及Sheets(i)移动工作表，按指定的顺序排列For i = 1 To WsCountWorksheets(WsArray(i)).Move before:=Sheets(i) Next iEnd Sub第七章批注1、Comment为Range对象的属性2、Comments返回指定工作表中所有的批注，可以利用For each对工作表中所有批注循环题目:(1)根据批注的作者，删除批注(2)隐藏工作表中所有批注(3)为区域中添加批注(4)测试Comments(index)返回指定工作表中第index个批注Sub 统计批注个数()Dim Flag As Comment'1、Comments返回指定工作表中所有的批注'2、用Comment属性返回一个Comment对象For Each Flag In mentst = t + 1Next FlagMsgBox "活动工作表中共有:" & t & "个批注", vbOKOnly, "统计批注个数" End SubSub CountComment()Dim Flag As Range'利用err来判断是否发生错误For Each Flag In edRangeOn Error Resume Nextt = ment.TextIf Err = 0 Then k = k + 1 Next FlagMsgBox "活动工作表中共有:" & k & "个批注", vbOKOnly, "统计批注个数" End SubSub 选定批注单元格()Dim a() As RangeDim Flag As RangeReDim a(ments.Count) For i = 1 To ments.CountSet a(i - 1) = ments(i).ParentNext iSet Flag = aFlag.SelectEnd SubSub selectcomment()'使用编辑定位功能，定位批注，选定单元格Cells.SpecialCells(xlCellTypeComments).SelectEnd SubSub 显示或隐藏批注()Dim Flag As CommentFor Each Flag In mentsIf Flag.Visible = True ThenFlag.Visible = FalseElseFlag.Visible = TrueEnd IfNext FlagEnd SubSub DisHideComment()'利用application的displaycommentindicator属性来显示隐藏批注'Indicator表示批注的标识符If Application.DisplayCommentIndicator = xlCommentAndIndicator Then Application.DisplayCommentIndicator = xlCommentIndicatorOnlyElseApplication.DisplayCommentIndicator = xlCommentAndIndicatorEnd IfEnd SubSub 输出所有批注()'在Sheet2工作表中返回Sheet1工作表中所有批注'这里使用ment.text返回批注中的内容Dim Flag As CommentDim t As Integeri = 1With Worksheets("Sheet2").Cells.Clear.Cells(1, 1) = "第n个批注".Cells(1, 2) = "批注地址".Cells(1, 3) = "批注内容"For Each Flag In Worksheets("Sheet1").Commentsi = i + 1t = t + 1.Cells(i, 1) = t.Cells(i, 2) = Flag.Parent.Address.Cells(i, 3) = ment.TextNext Flag.Columns("B:B").EntireColumn.AutoFit.Columns("C:C").ColumnWidth = 34.Cells.EntireRow.AutoFitEnd WithEnd SubSub 改变批注颜色()Dim Flag As CommentFor Each Flag In mentsFlag.Shape.Fill.ForeColor.SchemeColor = Int((80) * Rnd + 1) '1-80 Flag.Shape.TextFrame.Characters.Font.ColorIndex = Int((56) * Rnd + 1) '1-56Next FlagEnd SubSub 添加批注()Dim Flag As RangeOn Error Resume NextFor Each Flag In ActiveSheet.Range("g8:i17")t = t + 1Flag.AddComment.Text "hner:这是我添加的第" & t & "个批注" & Chr(13)+ Chr(10) & DateNext FlagEnd SubSub test()MsgBox ActiveSheet.Range("g8").Comment.AuthorEnd SubSub 删除批注()Dim Flag As RangeFor Each Flag In ActiveSheet.Range("g8:i17")ment.DeleteNext FlagEnd Sub第十章自定义函数函数一:计算销售佣金题1:根据销售额和对应的佣金率计算 =Sales*Rate 题2:根据销售额和对应的佣金率以及工作年限计算，工作每满一年佣金在原来的基础上增加一个百分点=Sales*Rate*(1+Year/100)条件临界点佣金率[0，10000) 0 0.08[10000，20000) 10000 0.105[20000，40000) 20000 0.12[40000，无穷) 40000 0.14计算方法:1、利用vlookup函数的模糊查找:=VLOOKUP(B2,$B$14:$C$17,2,TRUE)*B2 定期维护佣金率2、利用if函数结合&连接符突破if七层嵌套问题:=IF(AND(B2>=0,B2<$B$15),B2*$C$14,"")&IF(AND(B2>=$B$15,B2<$B$16),B2*$C$15,"")&IF(AND(B2>=$B$16,B2<$B$17), B2*$C$16,"")&IF(AND(B2>=$B$17),B2*$C$17,"")3、利用自定义函数，代码如下:Function Commission1(Sales, years) '计算销售佣金，工作每满一年，销售佣金在原来的基础上增加一个百分点 Const Rate1 = 0.08Const Rate2 = 0.105Const Rate3 = 0.12Const Rate4 = 0.14Select Case SalesCase 0 To 9999.99 'Case a to b 表示[a,b]两边都是闭区间Commission1 = Sales * Rate1Case 10000 To 19999.99Commission1 = Sales * Rate2Case 20000 To 39999.99Commission1 = Sales * Rate3Case ElseCommission1 = Sales * Rate4 End Select'每工作满一年，佣金在原来的基础上增加1个百分点Commission1 = Commission1 * (1 + years / 100)End FunctionSub 计算销售佣金()’在工作表中设计一个窗体按钮，执行此代码Dim SalesDim years As IntegerSales = Val(InputBox("请输入销售额:", "计算销售佣金"))years = Val(InputBox("请输入工作年限:", "计算销售佣金"))y = MsgBox("您的佣金为:" & Commission1(Sales, years), vbYesNo, "计算销售佣金") If y = vbYes Then '这里使用msgbox信息框，当单击是的时候，调用该过程本身计算销售佣金 End IfEnd Sub函数二:随机抽取某区域中的一个单元格目的:理解Optional定义变量和非易失性函数Volatile1、易失性函数:顾名思义该函数很容易改变，也就是无论何时在工作表任意单元格输入数据，易失性函数都需要重新计算，结合本例，只要在任意单元格输入数据，易失性函数都重新计算2、非易失性函数:顾名思义该函数不容易改变，也就是只有在函数中的参数值发生变化时，非易失性函数才重新计算，否则不计算，结合本例，只有在a1:a10输入数据，非易失性函数才重新计算，否则不计算3、Optional申明变量，表示该变量为可选参数4、假如Region为一个range对象区域，那么Region(i)表示区域Region中第i个对象代码如下:Function UnderstandVolatile(Region As Range, Optional FlagBoolean As Boolean = False)'利用optional定义变量表示该变量为可选参数'理解非易失性函数'函数功能:随机抽取Region区域中的一个单元格值'当application.volatile true时，表示易失性函数Application.Volatile FlagBoolean'产生[a,b]之间的随机整数 Int(rnd()*(b-a+1)+1)UnderstandVolatile = Region(Int(Rnd() * (Region.Count) + 1))End Function函数三:利用Optional来确定自定义函数是一个多单元格数组函数还是一个普通函数 MonthNames(OptionalMindex)函数功能:返回月份可选参数:1、当无参数时，返回一个多单元格数组公式，横向数组，将一个数组直接赋值给自定义函数2、当参数大于等于1时，返回对应月份，如参数为1，则返回Jan，参数为13，也同样返回Jan3、当参数小于等于0时，返回一个多单元格数组公式，垂直数组代码如下:Function MonthNames(Optional Mindex) '返回月份'Ismissing(t)表示t是否传递给过程，如果没有传递，则返回trueDim AllNames As VariantAllNames = Array("Jan", "Feb", "Mar", _"Apr", "May", "Jun", "Jul", "Aug", _"Sep", "Oct", "Nov", "Dec")If IsMissing(Mindex) ThenMonthNames = AllNamesElseSelect Case MindexCase Is >= 1'如果参数为1，则返回Jan，为数组的第一个元素，故应该用(Mindex-1 mod 12)，数组的下限为0，即AllNames(0)MonthNames = AllNames((Mindex - 1) Mod 12)Case ElseMonthNames = Application.WorksheetFunction.Transpose(AllNames)End SelectEnd IfEnd Function这里使用一个ismissing函数，该函数主要是用来测试是否将参数传递给过程，如果没有传递，则返回TRUE。

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") '返回69 MY 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 myNum1 As 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单元格。

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

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

1.1 创建宏 1例001 在Excel 2003中录制宏1例002 打开Excel 2007的录制宏功能 3例003 在Excel 2007中录制宏4例004 使用Visual Basic创建宏 51.2 管理宏 6例005 运行宏7例006 编辑宏8第2章VBE使用技巧VBE（Visual Basic Editor）是编写VBA代码的工具，在上一章中曾使用VBE编辑宏代码。

本章的实例介绍了设置VBE操作环境、在VBE中管理工程代码、使用VBE的辅助工具提高代码输入效率等方法。

2.1 设置VBE操作环境10例007 停靠VBE子窗口10例008 定制VBE环境122.2 工程管理13例009 增加模块13例010 删除模块15例011 导出模块16例012 导入模块172.3 管理代码18例013 属性/方法列表18例014 常数列表19例015 参数信息20例016 自动完成关键字21第3章程序控制流程技巧结构化程序设计中使用的基本控制结构有3种：顺序结构、选择结构和循环结构。

本章以实例演示了VBA中这三种控制结构的控制语句，最后还介绍了在VBA中使用数组的方法。

3.1 常用输入/输出语句23例017 九九乘法表（Print方法的应用）23例018 输入个人信息（Inputbox函数的应用）24例019 退出确认（Msgbox函数的应用）253.2 分支结构27例020 突出显示不及格学生27例021 从身份证号码中提取性别29例022 评定成绩等级30例023 计算个人所得税323.3 循环结构34例024 密码验证34例025 求最小公倍数和最大公约数36例026 输出ASCII码表37例027 计算选中区域数值之和39例028 换零钱法（多重循环）403.4 使用数组42例029 数据排序42例030 彩票幸运号码44例031 用数组填充单元格区域46第4章Range对象操作技巧用户在使用Excel时，大部分时间都是在操作单元格中的数据，同样地，在Excel中使用VBA 编程时，也需要频繁地引用单元格区域。

VBA在Excel中的应用一例VBA是建立在微软Office中的一种应用程序开发工具，为使用者提供了一种可编程的文字、表格处理手段，避免了因人工编辑出现错误和内容过多带来大量重复劳动，可以提高办公效率。

在Excel中，自身已经带有很多实用的公式，除满足日常计算应用外，还可以用VBA提供更高级的处理办法。

标签：VBA；Excel；程序开发如果深入了解過Excel，会发现其原有的公式非常强大，处理重复工作时还可以采用制作宏来解决，如果使用过宏命令，就相当于用到了一次简单的VBA 代码。

事实上，VBA编辑器在菜单中也是包含在“宏”的分类下的。

1 For-next语句的示例本文中，我们就以一个简单的“计算1到1000中各类数字和”的例子，来探索一下其应用。

在此，我们用到的是For-next语句。

即从开始执行语句后，反复执行For和Next之间的代码，直到执行完毕或遇到Exit for后终止，标准句式如下：For 循环变量=初始to 终值step 步长循环语句1[exit for]循环语句2Next 循环变量其中，步长、exit for和next后的变量均可省略，步长省略后的默认值为1，exit for是强制退出循环命令，执行后将直接跳到next后面。

在此，我们分别给出计算1-10000中整数和、偶数和以及奇数和这几个代码。

整数和：Sub naturesum（）Dim i&，j&For i=1 to 10000j=j+iNextMsgBox “1到10000的自然数和为：” &jEnd Sub偶数和：Sub 求1到10000之间偶数和（）Dim i&，j&For i = 0 To 10000 Step 2j = j+ iNextMsgBox “1到10000之间偶数和为” & jEnd Sub奇数和Sub 求1到10000之间奇数和（）Dim i&，j&For i = 1 To 10000 Step 2j = j + iNextMsgBox “1到10000之间奇数和为” & jEnd Sub可以看到，和其他语言如C语言中一样，变量的定义、循环语句的使用和中断是基本类似的。

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中的每个值，请高手指点。

Excel VBA（Visual Basic for Applications）是一种基于 Microsoft Visual Basic 编程语言的宏语言，可用于增强 Excel 的功能和自动化重复任务。

以下是一些 Excel VBA 的入门和实用例子，供参考：1. 基本语法和结构Excel VBA 代码通常以 `Sub` 或 `Function` 开头，后面跟着子程序或函数名称。

例如，下面是一个简单的 VBA 子程序，用于将单元格 A1 中的值设置为 "Hello World"。

```vbaSub SayHello()Range("A1").Value = "Hello World"End Sub```上述代码中，`Sub` 表示这是一个子程序，`SayHello()` 是子程序的名称。

`Range("A1")` 表示单元格 A1，`.Value` 表示该单元格的值，`"Hello World"` 就是要设置的新值。

2. 循环和条件语句Excel VBA 支持多种循环和条件语句，可以根据具体需求选择使用。

例如，下面是一个使用 `For` 循环的子程序，用于将单元格 A1 到 A10 中的值递增设置为 1 到 10。

```vbaSub FillNumbers()Dim i As IntegerFor i = 1 To 10Range("A" & i).Value = iNext iEnd Sub```上述代码中，`Dim` 声明了一个名为 i 的整数变量，`For` 循环从 1 到 10 遍历变量 i，`Range("A" & i)` 表示单元格 A1 到 A10 中的每个单元格，`.Value = i` 将该单元格的值设置为 i。

3. 用户输入和消息框Excel VBA 可以使用 `InputBox` 和 `MsgBox` 函数与用户进行交互。

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