[实用参考]VBA常用代码大全.doc

.、八、-刖言我们平时在工作表单元格的公式中常常使用函数，EGcel自带的常用的函数多达300多个, 功能强大，丰富多彩，但是在 VBA中不能直接应用，必须在函数名前面加上对象，比如：Applicatio n. WorksheetF un ctio n.Sum(arg1,arg2,arg3) 。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数, 以供大家学习参考。

第1.1例ASC函数一、题目：要求编写一段代码，运行后得到字符串”EGcel”的首字母和” e”的ASCII值。

二、代码：Sub 示例_1_01()DimmyNum1%,myNum2%myNum仁Asc("EGcel")'返回 69myNum2=Asc("e")' 返回 101[a1]="myNum 1=":[b1]=myNum1[a2]="myNum2=":[b2]=myNum2En dSub三、代码详解1、Sub示例_1_01():宏程序的开始语句。

2、DimmyNum1%,myNum2% :变量 myNum1 和 myNum2 声明为整型变量。

也可以写为DimmyNum1AsInteger 。

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

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

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

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

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

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

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

1：打开所有隐藏工作表Sub打开所有隐藏工作表()Dim i As IntegerFor i=1To Sheets.CountSheets(i).Visible=TrueNext iEnd Sub2：循环宏Sub循环()AAA=Range("C2")Dim i As LongDim times As Longtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i=1To timesCall过滤一行If Range("完成标志")="完成"ThenExit For'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A"&i).Text="完成"ThenExit For'假如某列出现"完成"内容则退出循环Next iEnd Sub3：录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible=TrueEnd Sub4：高级筛选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 Sub5：双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)If Range("$A$1")="关闭"ThenExit 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 Sub6：双击指定区域单元执行宏(工作表代码)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 Sub7：进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1")="关闭"Then Exit SubSelect Case Target.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字()Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3End SelectEnd Sub8：进入指定区域单元执行宏(工作表代码)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打开隐藏表End Sub9：在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0End SelectEnd Sub10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click()With CommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"Exit SubEnd IfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"Exit SubEnd IfEnd WithEnd Sub11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option Explicit Private 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 Sub12：根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13：当前单元返回按钮名称（控件按钮代码）Private Sub CommandButton1_Click()ActiveCell=CommandButton1.CaptionEnd Sub14：当前单元内容返回到按钮名称（控件按钮代码）Private Sub CommandButton1_Click()CommandButton1.Caption=ActiveCellEnd Sub15：奇偶页分别打印Sub奇偶页分别打印()Dim i%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."For i=1To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iMsgBox"现在打印偶数页,按确定开始."For i=2To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iEnd Sub16：自动打印多工作表第一页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 Sub17：查找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=1To timesCall插入分页符Next iEnd SubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18：将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 Then Pic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEnd IfNextEnd Sub19：返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEnd Sub20：在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEnd Sub21：返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBox tEnd Sub93：B列录入数据时在A列返回记录时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column=2ThenTarget.Offset(,-1)=NowEnd IfEnd Sub94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEnd IfEnd IfEnd SubPublic Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")End IfEnd IfEnd Sub95：指定单元显示光标位置内容（工作表代码）Private Sub Worksheet_SelectionChange(ByVal T As Range) Sheets(1).Range("A1")=SelectionEnd Sub96：每编辑一个单元保存文件Private Sub Worksheet_Change(ByVal Target As Range) ThisWorkbook.SaveEnd Sub97：指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"End Sub98：解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""End Sub99：删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub100：删除A列为指定内容的行Sub删除A列为指定内容的行()Dim a,b As Integera=Sheet1.[a65536].End(xlUp).RowFor b=a To2Step-1If Cells(b,1).Value="删除"ThenRows(b).DeleteEnd IfNextEnd SubExcel VBA常用代码总结1改变背景色Range("A1").Interior.ColorIndex = xlNone ColorIndex一览•改变文字颜色Range("A1").Font.ColorIndex = 1•获取单元格Cells(1, 2)Range("H7")•获取范围Range(Cells(2, 3), Cells(4, 5))Range("a1:c3")'用快捷记号引用单元格Worksheets("Sheet1").[A1:B5]•选中某sheetSet NewSheet = Sheets("sheet1")NewSheet.Select•选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。

目录一、引用 (2)二、Worksheet_Change事件： (2)三、相乘 (4)四、相减 (5)五、高级筛选 (5)六、双击事件 (7)七．单位汇总（sumif），单条件汇总 (9)八、多条件汇总（连接、sumif） (11)九、多条件汇总、ado (13)十、对账 (15)十一、sql筛选 (18)十二、sql连接、交叉汇总 (20)十三、select语句总结 (22)十四、报表(有层次) (23)一、引用相对引用B4绝对引用$B$4混合引用＄B4、B＄4F4进行引用切换,$在字母前面则锁定列，在数字前面则锁定行。

二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP（B4，简码表!＄B＄4：$C＄1000，2，FALSE)2。

Worksheet_Change事件代码：Private Sub Worksheet_Change（ByVal Target As Range）On error resume nextIf Target.Row > 3 And Target。

Column = 2 Theni = Target.RowCells(i， 3） = Application.WorksheetFunction.VLookup(Cells（i, 2), Sheets(”简码表”）.Range（"b4:c100"）, 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range）On Error Resume NextIf Target。

Row > 3 And Target。

Column = 5 Theni = Target.RowCells(i, 6） = Application.WorksheetFunction。

VLookup(Cells（i， 5）， Sheets(”类款项")。

1.删除重复行 (1)2. ActiveX控件的相关操作 (1)3. 单元格内容匹配 (2)4。

单元格填充公式 (3)5。

弹出打开对话框 (3)6. 操作文件夹下的所有工作簿 (3)7. 获取数据区域的最后一行和最后一列 (4)8. 获取列的字母顺序[A~IV］ (4)9. 自定义函数返回数组并填充至单元格区域 (4)10. 绘制曲线图 (5)11. 单元格区域拷贝 (5)12. 操纵数据库(查、增、删、改） (6)13。

待定XX (6)1.删除重复行关键字：[a65536］.End（xlUp).Row、Offset（)、相关双层循环Sub RemoveDuplicate(）'删除重复行For i = [a65536].End(xlUp)。

Row — 1 To 1 Step —1 '按倒叙删除For j = [a65536]。

End(xlUp).Row To i + 1 Step —1If Cells(i， 1)。

Value = Cells（j， 1）.Value ThenRows（i)。

DeleteEnd IfNextNextEnd SubSub RemoveItem()'删除相邻重复，但不删除隔行重复Dim i As LongWith Range（"A2”）’以A2为基准进行单元格偏移Do While .Offset(i, 0)If .Offset（i， 0)。

Value = .Offset（i — 1, 0）。

Value Then 。

Offset（i, 0）.EntireRow.Delete i = i + 1LoopEnd WithEnd Sub2.ActiveX控件的相关操作关键字：ActiveX、OLEObjects、ActiveSheet。

OLEObjects遍历控件Dim c As ObjectFor Each c In ActiveSheet.OLEObjectsIf = ”ComboBox” & i Then’…………。

前言我们平时在工作表xx的公式xx常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBAxx不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBAxx直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

***************** 定制模块行为 *****************Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有,仅对同一工程中其它模块有用,在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为 1On Error Resume Next '忽略错误继续执行 VBA代码,避免出现错误消息On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置On Error GoTo 0 '恢复正常的错误提示Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新Application.Enable.CancelKey=xlDisabled '禁用 Ctrl+Break 中止宏运行的功能Err.Clear '清除程序运行过程中所有的错误*********** 工作簿 ***********Workbooks.Add() '创建一个新的工作簿Workbooks("book1.xls").Activate '激活名为 book1的工作簿ThisWorkbook.Save '保存工作簿ThisWorkbook.close '关闭当前工作簿ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数 '返回活动工作薄的名称 '返回当前工作簿名称ThisWorkbook.FullName '返回当前工作簿路径和名称ActiveWindow.EnableResize=False '禁止调整活动工作簿的大小Application.Window.Arrange xlArrangeStyleTiled '将工作簿以平铺方式排列ActiveWorkbook.WindowState=xlMaximized '将当前工作簿最大化ThisWorkbook.BuiltinDocumentProperties(""Last Save Time")或 Application.Caller.Parent.Parent.BuiltinDocumentProperties(""Last Save Time") '返回上次保存工作簿的日期和时间ThisWorkbook.BuiltinDocumentProperties("Last Print Date")或 Application.Caller.Parent.Parent.BuiltinDocumentProperties(""Last Print Date") '返回上次打印或预览工作簿的日期和时间Workbooks.Close '关闭所有打开的工作簿ActiveWorkbook.LinkSources(xlExcelLinks)'返回当前工作簿中的第一条链接ActiveWorkbook.CodeNameThisWorkbook.CodeName '返回工作簿代码的名称ActiveWorkbook.FileFormatThisWorkbook.FileFormat '返回当前工作簿文件格式代码ThisWorkbook.PathActiveWorkbook.Path '返回当前工作簿的路径(注:若工作簿未保存,则为空) ThisWorkbook.ReadOnlyActiveWorkbook.ReadOnly '返回当前工作簿的读/写值(为 False) ThisWorkbook.SavedActiveWorkbook.Saved '返回工作簿的存储值(若已保存则为 False) Application.Visible = False '隐藏工作簿Application.Visible = True '显示工作簿注:可与用户窗体配合使用,即在打开工作簿时将工作簿隐藏,只显示用户窗体.可设置控制按钮控制工作簿可见*********** 工作表 ***********edRange.Rows.Count '当前工作表中已使用的行数Rows.Count '获取工作表的行数(注：考虑向前兼容性)Sheets(Sheet1).Name= "Sum" '将 Sheet1命名为 SumThisWorkbook.Sheets.Add Before:=Worksheets'添加一个新工作表在第一工作表前ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后Worksheets(Array("sheet1","sheet2")).Select '同时选择工作表 1和工作表2Sheets("sheet1").Delete或 Sheets(1).Delete '删除工作表 1 ActiveWorkbook.Sheets(i).Name '获取工作表 i的名称ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示,这种方法也可以用在其它方面进行相互切换,即相当于开关按钮ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings '切换工作表中的行列边框显示edRange.FormatConditions.Delete '删除当前工作表中所有的条件格式Cells.Hyperlinks.Delete '取消当前工作表所有超链接ActiveSheet.PageSetup.Orientation=xlLandscape或 ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName '在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName '将用户名放置在活动工作表的页脚ActiveSheet.Columns("B").Insert '在A 列右侧插入列,即插入 B 列ActiveSheet.Columns("E").CutActiveSheet.Columns("B").Insert '以上两句将 E 列数据移至 B 列,原 B 列及以后的数据相应后移ActiveSheet.Columns("B").CutActiveSheet.Columns("E").Insert '以上两句将 B列数据移至 D列,原 C列和D列数据相应左移一列ActiveSheet.Calculate '计算当前工作表ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetHidden '正常隐藏工作表,同在 Excel 菜单中选择""格式——工作表——隐藏"操作一样ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetVeryHidden '隐藏工作表,不能通过在 Excel 菜单中选择""格式——工作表——取消隐藏"来重新显示工作表ThisWorkbook.Worksheets(""sheet1").Visible=xlSheetVisible '显示被隐藏的工作表ThisWorkbook.Sheets(1).ProtectContents '检查工作表是否受到保护ThisWorkbook.Worksheets.Add Count:=2,Before:=ThisWorkbook.Worksheets(2)或 ThisWorkbook.Workshees.Add ThisWorkbook.Worksheets(2), , 2 '在第二个工作表之前添加两个新的工作表ThisWorkbook.Worksheets(3).Copy '复制一个工作表到新的工作簿ThisWorkbook.Worksheets(3).Copy ThisWorkbook.Worksheets'复制第三个工作表到第二个工作表之前ThisWorkbook.ActiveSheet.Columns.ColumnWidth = 20 '改变工作表的列宽为20ThisWorkbook.ActiveSheet.Columns.ColumnWidth =ThisWorkbook.ActiveSheet.StandardWidth '将工作表的列宽恢复为标准值ThisWorkbook.ActiveSheet.Columns(1).ColumnWidth = 20 '改变工作表列 1的宽度为 20ThisWorkbook.ActiveSheet.Rows.RowHeight = 10 '改变工作表的行高为 10 ThisWorkbook.ActiveSheet.Rows.RowHeight =ThisWorkbook.ActiveSheet.StandardHeight '将工作表的行高恢复为标准值ThisWorkbook.ActiveSheet.Rows(1).RowHeight = 10 '改变工作表的行 1的高度值设置为 10ThisWorkbook.Worksheets(1).Activate '当前工作簿中的第一个工作表被激活ThisWorkbook.Worksheets("Sheet1").Rows(1).Font.Bold = True '设置工作表Sheet1中的行1数据为粗体ThisWorkbook.Worksheets("Sheet1").Rows(1).Hidden = True '将工作表Sheet1中的行1隐藏ActiveCell.EntireRow.Hidden = True '将当前工作表中活动单元格所在的行隐藏注：同样可用于列。

30个有用的ExcelVBA代码（1~5）原创浮云Excel 2019-03-29 11:58:001.显示多个隐藏的工作表如果你的工作簿里面有多个隐藏的工作表，你需要花很多时间一个一个的显示隐藏的工作表。

下面的代码，可以让你一次显示所有的工作表Sub UnhideAllWoksheets()Dim ws As WorksheetFor Each ws In ActiveWorkbook.Worksheetsws.Visible = xlSheetVisibleNext wsEnd Sub2.隐藏除了活动工作表外的所有工作表如果你做的报表，希望隐藏除了报表工作表以外的所有工作表，则可以用一下代码来实现：Sub HideAllExcetActiveSheet()Dim ws As WorksheetFor Each ws In ThisWorkbook.WorksheetsIf <> Thenws.Visible = xlSheetHiddenEnd ifNext wsEnd Sub3.用VBA代码按字母的顺序对工作表进行排序如果你有一个包含多个工作表的工作簿，并且希望按字母对工作表进行排序，那么下面的代码，可以派上用场。

Sub SortSheetsTabName()Application.ScreenUpdating = FalseDim ShCount As Integer, i As Integer, j As IntegerShCount = Sheets.CountFor i = 1 To ShCount - 1For j = i + 1 To ShCountIf Sheets(j).Name < Sheets(i).Name ThenSheets(j).Move before:=Sheets(i)End IfNext jNext iApplication.ScreenUpdating = TrueEnd Sub4.一次性保护所有的工作表如果工作薄里面有多个工作表，并且希望保护所有的工作表，那么下面的代码，可以派上用场。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

1：打开所有隐藏工作表Sub打开所有隐藏工作表()Dim i As IntegerFor i=1To Sheets.CountSheets(i).Visible=TrueNext iEnd Sub2：循环宏Sub循环()AAA=Range("C2")Dim i As LongDim times As Longtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i=1To timesCall过滤一行If Range("完成标志")="完成"ThenExit For'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A"&i).Text="完成"ThenExit For'假如某列出现"完成"内容则退出循环Next iEnd Sub3：录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible=TrueEnd Sub4：高级筛选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 Sub5：双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)If Range("$A$1")="关闭"ThenExit 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 Sub6：双击指定区域单元执行宏(工作表代码)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 Sub7：进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1")="关闭"Then Exit SubSelect Case Target.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字()Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3End SelectEnd Sub8：进入指定区域单元执行宏(工作表代码)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打开隐藏表End Sub9：在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0End SelectEnd Sub10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click()With CommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"Exit SubEnd IfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"Exit SubEnd IfEnd WithEnd Sub11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option Explicit Private 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 Sub12：根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13：当前单元返回按钮名称（控件按钮代码）Private Sub CommandButton1_Click()ActiveCell=CommandButton1.CaptionEnd Sub14：当前单元内容返回到按钮名称（控件按钮代码）Private Sub CommandButton1_Click()CommandButton1.Caption=ActiveCellEnd Sub15：奇偶页分别打印Sub奇偶页分别打印()Dim i%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."For i=1To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iMsgBox"现在打印偶数页,按确定开始."For i=2To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iEnd Sub16：自动打印多工作表第一页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 Sub17：查找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=1To timesCall插入分页符Next iEnd SubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18：将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 Then Pic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEnd IfNextEnd Sub19：返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEnd Sub20：在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEnd Sub21：返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBox tEnd Sub93：B列录入数据时在A列返回记录时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column=2ThenTarget.Offset(,-1)=NowEnd IfEnd Sub94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEnd IfEnd IfEnd SubPublic Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")End IfEnd IfEnd Sub95：指定单元显示光标位置内容（工作表代码）Private Sub Worksheet_SelectionChange(ByVal T As Range) Sheets(1).Range("A1")=SelectionEnd Sub96：每编辑一个单元保存文件Private Sub Worksheet_Change(ByVal Target As Range) ThisWorkbook.SaveEnd Sub97：指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"End Sub98：解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""End Sub99：删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub100：删除A列为指定内容的行Sub删除A列为指定内容的行()Dim a,b As Integera=Sheet1.[a65536].End(xlUp).RowFor b=a To2Step-1If Cells(b,1).Value="删除"ThenRows(b).DeleteEnd IfNextEnd SubExcel VBA常用代码总结1改变背景色Range("A1").Interior.ColorIndex = xlNone ColorIndex一览•改变文字颜色Range("A1").Font.ColorIndex = 1•获取单元格Cells(1, 2)Range("H7")•获取范围Range(Cells(2, 3), Cells(4, 5))Range("a1:c3")'用快捷记号引用单元格Worksheets("Sheet1").[A1:B5]•选中某sheetSet NewSheet = Sheets("sheet1")NewSheet.Select•选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。

vba经典代码以下是一些经典的VBA代码示例：1. 在单元格中显示当前日期：```vbaRange("A1"Value = Date```2. 在单元格中显示当前时间：```vbaRange("A1"Value = Time```3. 在单元格中显示当前日期和时间：```vbaRange("A1"Value = Now```4. 循环遍历并处理所有工作表：```vbaDim ws As WorksheetFor Each ws In Worksheets"在此处添加处理代码Next ws```5. 将工作表中的数据复制到另一个工作表：```vbaWorksheets("Sheet1"UsedRange.CopyDestination:=Worksheets("Sheet2"Range("A1"```6. 打开文件对话框并选择文件路径：```vbaDim filePath As VariantfilePath = Application.GetOpenFilename("Excel 文件(*.xlsx),*.xlsx"If filePath <> False Then"在此处添加处理已选择文件的代码End If```7. 创建新工作簿并保存：```vbaDim newWorkbook As WorkbookSet newWorkbook = Workbooks.AddnewWorkbook.SaveAs "C:""路径""文件名.xlsx"```8. 删除所有空行：```vbaDim lastRow As LonglastRow = Cells(Rows.Count, 1).End(xlUp).RowOn Error Resume NextActiveSheet.Range("A1:A" &lastRow).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp On Error GoTo 0```9. 过滤数据并复制到另一个工作表：```vbaActiveSheet.Range("A1:D10"AutoFilter Field:=1,Criteria1:="条件"ActiveSheet.Range("A2:D10"SpecialCells(xlCellTypeVisible). CopyDestination:=Worksheets("Sheet2"Range("A1"ActiveSheet.AutoF ilterMode = False```10. 遍历并选择某一列中的所有唯一值：```vbaDim uniqueValues As CollectionSet uniqueValues = New CollectionDim cellValue As VariantOn Error Resume NextFor Each cellValue In Range("A1:A10" uniqueValues.Add cellValue, CStr(cellValue)Next cellValueOn Error GoTo 0```。

VBA代码全集VBA代码全集一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。

二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2. Worksheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row > 3 And Target.Column = 2 Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets("简码表").Range("b4:c100"), 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row > 3 And Target.Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 2, False)Cells(i, 7) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 3, False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 4, False)End IfEnd Sub三、相乘Sub 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range("a3").End(xldown).RowFor i = 4 To irowCells(i, 3) = Cells(i, 1) * Cells(i, 2)Next iApplication.ScreenUpdating = TrueEnd Sub四、相减Sub 相减()Application.ScreenUpdating = FalseRange("c3:c10000").ClearContentsDim i As LongDim irow As Longirow = Range("a5000").End(xlUp).RowFor i = 3 To irowCells(i, 3) = VBA.Round((Cells(i, 1) - Cells(i, 2)), 2) Next iApplication.ScreenUpdating = TrueEnd Sub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）Sub 高级筛选()Sheets("业务").Range("A3:I10000").AdvancedFilterAction:=xlFilterCopy, _CopyToRange:=ActiveCell.Range("A1:B1"), Unique:=TrueEnd Sub六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Row > 3 And Target.Column = 6 Then UserForm1.ShowSheets("初始化").Range("m3") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Row > 3 And Target.Column = 6 Then UserForm1.ShowSheets("初始化").Range("c2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 7 ThenUserForm2.ShowSheets("初始化").Range("f2") = ActiveCellElseIf Target.Row > 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd Sub4．右键点击Userform1查看代码 Listbox1 dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)Unload MeEnd Sub见上图5.插入用户窗体右键点击userform2 worksheet dblclickPrivate Sub ListBox1_DblClick(ByVal Cancel AsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubUserform initializePrivate Sub UserForm_Initialize()Application.ScreenUpdating = FalseWith Sheets("初始化")Sheets("科目表").Range("h2:i10000").AdvancedFilterAction:=xlFilterCopy, _CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=TrueEnd WithEnd Sub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)Sub 单位汇总1()Application.ScreenUpdating = Falserange("a1:i10000").ClearCells(3, 2) = "指标数"Cells(3, 3) = "拨款数"Cells(3, 4) = "余额"Cells(1, 7) = "单位"Cells(3, 7) = "单位"Cells(3, 8) = "指标数"Cells(3, 9) = "拨款数"Sheets("业务").Range("D3:D10000").AdvancedFilterAction:=xlFilterCopy, _CopyToRange:=Range("A3"), Unique:=TrueSheets("业务").Range("A3:J10000").AdvancedFilterAction:=xlFilterCopy, _CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=False Dim i As LongDim irow As Longirow = Range("a3").End(xlDown).RowFor i = 4 To irowCells(i, 2) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("h4:h10000"))Cells(i, 3) = Application.WorksheetFunction.SumIf(Range("g4:g10000"), Cells(i, 1), Range("i4:i10000"))Cells(i, 4) = VBA.Round(Cells(i, 2) - Cells(i, 3), 2)Next iRange("g1:i10000").ClearApplication.ScreenUpdating = TrueEnd Sub八、多条件汇总（连接、sumif）连接=k4&l4&m4&n4Vba：Sub 多条件汇总()Application.ScreenUpdating = FalseRange("a1:p10000").ClearSheets("业务").Range("D3:G10000").AdvancedFilterAction:=xlFilterCopy, _CopyToRange:=Range("B3:E3"), Unique:=True Sheets("业务").Range("D3:I10000").AdvancedFilterAction:=xlFilterCopy, _CopyToRange:=Range("K3:P3"), Unique:=False Dim j As LongDim jrow As Longjrow = Range("k3").End(xlDown).RowFor j = 4 To jrowCells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)Next jDim i As LongDim irow As Longirow = Range("b3").End(xlDown).RowFor i = 4 To irowCells(3, 6) = "指标数"Cells(3, 7) = "拨款数"Cells(3, 8) = "余额"Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)Cells(i, 6) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("o4:o10000"))Cells(i, 7) = Application.WorksheetFunction.SumIf(Range("j4:j10000"), Cells(i, 1), Range("p4:p10000"))Cells(i, 8) = VBA.Round(Cells(i, 6) - Cells(i, 7), 2)Next iRange("i3:p10000").ClearRange("a1:a10000").Delete Application.ScreenUpdating = True End Sub九、多条件汇总、adoSub 多条件汇总()Application.ScreenUpdating = False Dim i As IntegerDim strsql As StringDim cnn As New ADODB.Connection Dim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("多条件汇总").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("多条件汇总").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingEnd Sub 十、对账Sub 预算股()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项" rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("对帐").Cells(3, i + 10) = rst1.Fields(i - 1).NameNext iSheets("对帐").Range("k4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("对帐").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("对帐").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = Nothings = Application.WorksheetFunction.CountA(Range("k4 :k10000")) + 4Range("T4:W10000").SelectSelection.CopyRange("K" & s).SelectActiveSheet.PasteRange("X4:X10000").SelectSelection.CopyRange("P" & s).SelectActiveSheet.PasteRange("X3").SelectSelection.CopyRange("P3").SelectActiveSheet.PasteDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标from[对帐$k3:p50000] GROUP BY 单位,类,款,项" rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("对帐").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("对帐").Range("a4").CopyFromRecordsetrstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = True End Sub十一、sql筛选Sub 筛选()Application.ScreenUpdating = False Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("筛选").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("筛选").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十二、sql连接、交叉汇总Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 股,月,归口,单位,类,款,项,指标数 from [专业$a3:h10000] union ALL SELECT 股,月,归口,单位,类,款,项,指标数from [预算$a3:l10000] order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(1, i + 19) = rst.Fields(i - 1).NameNext iSheets("连接").Range("t2").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 汇总()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " transform sum(指标数) SELECT 单位,类,款,项 from [连接$t1:aa10000] where 归口= '" & Range("h2").Value & "' and 月=" & Range("i2").Value & " group by 单位,类,款,项pivot 股"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("连接").Cells(3, i) = rst.Fields(i - 1).NameNext iSheets("连接").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingEnd Sub十三、select语句总结1、筛选（false ---筛选全部）Select 列表名称1,列表名称2,…….列表名称n from [表$区域]或者Select * from [表$区域]2、筛选唯一的数据Select distinct 列表名称1,列表名称2,…….列表名称n from [表$区域]3、分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Group by列表名称1,列表名称2,…….列表名称n4、条件分类汇总Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]Where 归口=’”& range(“”).value &”’ and 月=”& range(“”).value &” Group by列表名称1,列表名称2,…….列表名称n5、交叉汇总Transform sum() select 列名称1,……列名称n from[表$区域] group by 列名称1，…..列名称n pivot 交叉事项6、连接Select 列名称1表$区域] unionall Select 列名称1n from[表$区域] order by 列名称 desc十四、报表（有层次）连接Transform sum（指标数），pivot 股按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序1、整体写代码Sub 报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql1 = " SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 股,月,归口,单位,类,款,项 order by 股 desc"rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets("报表").Cells(3, i + 9) = rst1.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql2 = "transform sum(指标数) SELECT 单位,类,款,项 from[报表$j3:q10000] where 归口='" & Range("g2") _.Value & "' and 月<=" & Range("h2").Value & "group by 单位,类,款,项 order by 单位 desc pivot 股 "rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets("报表").Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = NothingDim strsql3 As StringDim cnn3 As New ADODB.ConnectionDim rst3 As New ADODB.Recordsetcnn3.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql3 = "SELECT 单位,类,款,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000] group by 单位,类,款 order by 单位 desc"rst3.Open strsql3, cnn3For i = 1 To rst3.Fields.CountSheets("报表").Cells(3, i + 26) = rst3.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3 = NothingSet cnn3 = NothingDim strsql4 As StringDim cnn4 As New ADODB.ConnectionDim rst4 As New ADODB.Recordsetcnn4.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql4 = "SELECT 单位,类,sum(专业股) as 专业group by 单位,类 order by 单位 desc"rst4.Open strsql4, cnn4For i = 1 To rst4.Fields.CountSheets("报表").Cells(3, i + 32) = rst4.Fields(i - 1).NameNext iSheets("报表").Range("ag4").CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4 = NothingSet cnn4 = NothingDim strsql5 As StringDim cnn5 As New ADODB.ConnectionDim rst5 As New ADODB.Recordsetcnn5.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql5 = "SELECT 单位,sum(专业股) as 专业group by 单位 order by 单位 desc"rst5.Open strsql5, cnn5For i = 1 To rst5.Fields.CountSheets("报表").Cells(3, i + 37) = rst5.Fields(i - 1).NameNext iSheets("报表").Range("al4").CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5 = NothingSet cnn5 = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightRange("ad3") = "项"Columns("Aj:Ak").SelectSelection.Insert Shift:=xlToRightRange("aj3") = "款"Range("ak3") = "项"Columns("Ap:Ar").SelectSelection.Insert Shift:=xlToRightRange("ap3") = "类"Range("aq3") = "款"Range("ar3") = "项"Dim strsql6 As StringDim cnn6 As New ADODB.ConnectionDim rst6 As New ADODB.Recordsetcnn6.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql6 = " SELECT 单位,类,款,项,专业股,预算股from [报表$t3:y10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算股from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表$ao3:at10000] order by 单位 desc,类,款,项 "rst6.Open strsql6, cnn6For i = 1 To rst6.Fields.CountSheets("报表").Cells(3, i) = rst6.Fields(i - 1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6 = NothingSet cnn6 = NothingRange("j1:au10000").ClearContentsDim p As LongDim prow As Longprow = Range("a3").End(xlDown).RowFor p = 4 To prowRange("g3") = "金额"Cells(p, 7) = VBA.Round(Cells(p, 6) - Cells(p, 5), 2)Next pApplication.ScreenUpdating = TrueEnd Sub2、分开写代码：Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标数 from[预算$a3:l10000] group by 月, 归口,股,单位,类,款,项 order by 股 desc"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 9) = rst.Fields(i - 1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 项()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = "transform sum(指标数) SELECT 单位,类,款,项 from [报表$j3:q10000] where 归口= '" &Range("g2").Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项pivot 股"rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 19) = rst.Fields(i - 1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 款()Application.ScreenUpdating = FalseCall 项Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类,款, sum(专业股) as 专业股, sum(预算股) as 预算股from [报表$t3:y10000] group by 单位,类,款 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 26) = rst.Fields(i - 1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightCells(3, 30) = "项"Application.ScreenUpdating = TrueEnd SubSub 类()Application.ScreenUpdating = FalseCall 款Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data Source=" & ThisWorkbook.FullNamestrsql = " SELECT 单位,类, sum(专业股) as 专业股, sum(预算股) as 预算股from [报表$aa3:af10000] group by 单位,类 "rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets("报表").Cells(3, i + 33) = rst.Fields(i - 1).NameNext iSheets("报表").Range("ah4").CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingColumns("AJ:AJ").SelectSelection.Insert Shift:=xlToRightColumns("AK:AK").SelectSelection.Insert Shift:=xlToRightRange("AJ3").SelectActiveCell.FormulaR1C1 = "款"Range("AK3").SelectActiveCell.FormulaR1C1 = "项"Application.ScreenUpdating = TrueEnd SubSub 单位()Application.ScreenUpdating = FalseCall 类Dim i As Integer。

VBA实用代码VBA实用代码1.判断一个表的最后一行:i = Range("A65536").End(xlUp).Row2.取最后一列列号：m = Range("dz1").End(xlT oLeft).Column3.遍历工作簿中所有表i=1For Each m In Sheets '遍历每个工作表cells(i,1)= '取工作表名cells(i,2)=sheets().cells(1,1) '取工作表第一个单元格内容i=i+1next4.求某月天数Function tianshu(riqi As Date) As Bytetianshu = DateSerial(Year(riqi), Month(riqi) + 1, Day(riqi)) - riqiEnd Function'求月末日期Function yuemo(riqi As Date) As Dateyuemo = DateSerial(Year(riqi), Month(riqi) + 1, 0)End Function5.禁止别人运行Word程序的VBA代码禁止别人运行Word程序的VBA代码单击“工具→宏→宏…”命令，在弹出的对话模型中输入宏名“autoexec”，然后单击“创建”，在代码窗中输入如下内容，即可控制别人运行WORD：Sub autoexec()Dim psw As Stringpsw = inputbox("请输入密码：", "登录？")If psw = "elong" ThenApplication.ShowMeElsemsgbox "对不起，请您与本机主人联系!"Application.QuitEnd IfEnd Sub破解办法：(1)、禁止自运行宏、(2)、或者直接删除normal.dot模板文件即可。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。

目录一、引用 (3)二、Worksheet_Change事件： (3)三、相乘 (5)四、相减 (6)五、高级筛选 (6)六、双击事件 (8)七．单位汇总（sumif），单条件汇总 (10)八、多条件汇总（连接、sumif） (13)九、多条件汇总、ado (15)十、对账 (16)十一、sql筛选 (20)十二、sql连接、交叉汇总 (21)十三、select语句总结 (23)十四、报表（有层次） (24)一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。

二、Worksheet_Change事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2.Worksheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume nextIf Target.Row>3And Target.Column=2Theni=Target.RowCells(i,3)=Application.WorksheetFunction.VLookup(Cells(i,2),Sheets("简码表End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row>3And Target.Column=5Theni=Target.RowCells(i,6)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:e2000"),2, False)Cells(i,7)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:e2000"),3, False)Cells(i,8)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:e2000"),4, False)End IfEnd Sub三、相乘Sub计算金额()Application.ScreenUpdating=FalseDim i As LongDim irow As Longirow=Range("a3").End(xldown).RowFor i=4To irowCells(i,3)=Cells(i,1)*Cells(i,2)Next iApplication.ScreenUpdating=TrueEnd Sub四、相减Sub相减()Application.ScreenUpdating=FalseRange("c3:c10000").ClearContentsDim i As LongDim irow As Longirow=Range("a5000").End(xlUp).RowFor i=3To irowCells(i,3)=VBA.Round((Cells(i,1)-Cells(i,2)),2)Next iApplication.ScreenUpdating=TrueEnd Sub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）Sub高级筛选()Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy,_ CopyToRange:=ActiveCell.Range("A1:B1"),Unique:=TrueEnd Sub六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource 为box1依次类推3.业务表-查看代码Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If Target.Row>3And Target.Column=6ThenUserForm1.ShowSheets("初始化").Range("m3")=ActiveCellElseIf Target.Row>3And Target.Column=7ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If Target.Row>3And Target.Column=6ThenUserForm1.ShowSheets("初始化").Range("c2")=ActiveCellElseIf Target.Row>3And Target.Column=7ThenUserForm2.ShowSheets("初始化").Range("f2")=ActiveCellElseIf Target.Row>3And Target.Column=8ThenUserForm3.ShowEnd IfEnd Sub4．右键点击Userform1查看代码Listbox1dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox1.ListIndex,0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox2.ListIndex,0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox3.ListIndex,0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox4.ListIndex,0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox5.ListIndex,0)Unload MeEnd Sub见上图5.插入用户窗体右键点击userform2worksheet dblclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,7)=ListBox1.List(ListBox1.ListIndex,0)Unload MeEnd SubUserform initializePrivate Sub UserForm_Initialize()Application.ScreenUpdating=FalseWith Sheets("初始化")Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy,_ CriteriaRange:=.Range("m2:m3"),CopyToRange:=.Range("n2"),Unique:=TrueEnd WithApplication.ScreenUpdating=TrueEnd Sub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)Sub单位汇总1()Application.ScreenUpdating=Falserange("a1:i10000").ClearCells(3,2)="指标数"Cells(3,3)="拨款数"Cells(3,4)="余额"Cells(1,7)="单位"Cells(3,7)="单位"Cells(3,8)="指标数"Cells(3,9)="拨款数"Sheets("业务").Range("D3:D10000").AdvancedFilter Action:=xlFilterCopy,_CopyToRange:=Range("A3"),Unique:=TrueSheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy,_CriteriaRange:=Range("G1:G2"),CopyToRange:=Range("G3:I3"),Unique:=FalseDim i As LongDim irow As Longirow=Range("a3").End(xlDown).RowFor i=4To irowCells(i,2)=Application.WorksheetFunction.SumIf(Range("g4:g10000"),Cells(i,1), Range("h4:h10000"))Cells(i,3)=Application.WorksheetFunction.SumIf(Range("g4:g10000"),Cells(i,1), Range("i4:i10000"))Cells(i,4)=VBA.Round(Cells(i,2)-Cells(i,3),2)Next iRange("g1:i10000").ClearApplication.ScreenUpdating=TrueEnd Sub八、多条件汇总（连接、sumif）连接=k4&l4&m4&n4Vba：Sub多条件汇总()Application.ScreenUpdating=FalseRange("a1:p10000").ClearSheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy,_ CopyToRange:=Range("B3:E3"),Unique:=TrueSheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy,_CopyToRange:=Range("K3:P3"),Unique:=FalseDim j As LongDim jrow As Longjrow=Range("k3").End(xlDown).RowFor j=4To jrowCells(j,10)=Cells(j,11)&Cells(j,12)&Cells(j,13)&Cells(j,14)Next jDim i As LongDim irow As Longirow=Range("b3").End(xlDown).RowFor i=4To irowCells(3,6)="指标数"Cells(3,7)="拨款数"Cells(3,8)="余额"Cells(i,1)=Cells(i,2)&Cells(i,3)&Cells(i,4)&Cells(i,5)Cells(i,6)=Application.WorksheetFunction.SumIf(Range("j4:j10000"),Cells(i,1), Range("o4:o10000"))Cells(i,7)=Application.WorksheetFunction.SumIf(Range("j4:j10000"),Cells(i,1), Range("p4:p10000"))Cells(i,8)=VBA.Round(Cells(i,6)-Cells(i,7),2)Next iRange("i3:p10000").ClearRange("a1:a10000").DeleteApplication.ScreenUpdating=TrueEnd Sub九、多条件汇总、adoSub多条件汇总()Application.ScreenUpdating=FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,类,款,项,sum(指标数)as预算股指标,sum(拨款数)as预算股拨款from[业务$a3:J10000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUP BY单位,类,款,项"rst.Open strsql,cnnFor i=1To rst.Fields.CountNext iSheets("多条件汇总").Range("a4").CopyFromRecordset rst rst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=TrueEnd Sub十、对账Sub预算股()Application.ScreenUpdating=FalseDim i As IntegerDim strsql1As StringDim cnn1As New ADODB.ConnectionDim rst1As New ADODB.Recordsetcnn1.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql1="SELECT单位,类,款,项,sum(指标数)as预算股指标from[预算股$a3:m50000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUP BY单位,类,款,项" rst1.Open strsql1,cnn1For i=1To rst1.Fields.CountSheets("对帐").Cells(3,i+10)=rst1.Fields(i-1).NameNext iSheets("对帐").Range("k4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1=NothingSet cnn1=NothingDim strsql2As StringDim cnn2As New ADODB.ConnectionDim rst2As New ADODB.Recordsetcnn2.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql2="SELECT单位,类,款,项,sum(指标数)as专业股指标from[专业股$a3:j50000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUP BY单位,类,款,项" rst2.Open strsql2,cnn2For i=1To rst2.Fields.CountSheets("对帐").Cells(3,i+19)=rst2.Fields(i-1).NameNext iSheets("对帐").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2=NothingSet cnn2=Nothings=Application.WorksheetFunction.CountA(Range("k4:k10000"))+4Range("T4:W10000").SelectSelection.CopyRange("K"&s).SelectActiveSheet.PasteDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,类,款,项,sum(预算股指标)as预算股指标,sum(专业股指标)as专业股指标from[对帐$k3:p50000]GROUP BY单位,类,款,项"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("对帐").Cells(3,i)=rst.Fields(i-1).NameNext iSheets("对帐").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=TrueEnd Sub十一、sql筛选Sub筛选()Application.ScreenUpdating=FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT distinct单位,类,款,项from[专业$a3:h10000]"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("筛选").Cells(3,i)=rst.Fields(i-1).NameNext iSheets("筛选").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=True End Sub十二、sql连接、交叉汇总Sub连接()Application.ScreenUpdating=FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT股,月,归口,单位,类,款,项,指标数from[专业$a3:h10000]union ALL SELECT股,月,归口,单位,类,款,项,指标数from[预算$a3:l10000]order by股desc"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("连接").Cells(1,i+19)=rst.Fields(i-1).NameNext iSheets("连接").Range("t2").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=TrueEnd SubSub汇总()Application.ScreenUpdating=FalseCall连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="transform sum(指标数)SELECT单位,类,款,项from[连接$t1:aa10000]where归口='" &Range("h2").Value&"'and月="&Range("i2").Value&"group by单位,类,款,项pivot股" rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("连接").Cells(3,i)=rst.Fields(i-1).NameNext iSheets("连接").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingRange("t1:aa10000").ClearContentsApplication.ScreenUpdating=TrueEnd Sub十三、select语句总结1、筛选（false---筛选全部）Select列表名称1,列表名称2,…….列表名称n from[表$区域]或者Select*from[表$区域]2、筛选唯一的数据Select distinct列表名称1,列表名称2,…….列表名称n from[表$区域]3、分类汇总Select列表名称1,列表名称2,…….列表名称n，sum(a)as a from[表$区域]Group by列表名称1,列表名称2,…….列表名称n4、条件分类汇总Select列表名称1,列表名称2,…….列表名称n，sum(a)as a from[表$区域]Where归口=’”&range(“”).value&”’and月=”&range(“”).value&”Group by列表名称1,列表名称2,…….列表名称n5、交叉汇总Transform sum()select列名称1,……列名称n from[表$区域]group by列名称1，…..列名称n pivot交叉事项6、连接Select列名称1，…列名称n from[表$区域]union all Select列名称1，…列名称n from[表$区域]order by列名称desc十四、报表（有层次）连接Transform sum（指标数），pivot股按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序1、整体写代码Sub报表()Application.ScreenUpdating=FalseDim i As IntegerDim strsql1As StringDim cnn1As New ADODB.ConnectionDim rst1As New ADODB.Recordsetcnn1.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql1="SELECT股,月,归口,单位,类,款,项,sum(指标数)as指标数from[专业$a3:h10000] group by股,月,归口,单位,类,款,项union all SELECT股,月,归口,单位,类,款,项,sum(指标数)as 指标数from[预算$a3:l10000]group by股,月,归口,单位,类,款,项order by股desc"rst1.Open strsql1,cnn1For i=1To rst1.Fields.CountSheets("报表").Cells(3,i+9)=rst1.Fields(i-1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1=NothingSet cnn1=NothingDim strsql2As StringDim cnn2As New ADODB.ConnectionDim rst2As New ADODB.Recordsetcnn2.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql2="transform sum(指标数)SELECT单位,类,款,项from[报表$j3:q10000]where归口='"& Range("g2")_.Value&"'and月<="&Range("h2").Value&"group by单位,类,款,项order by单位desc pivot 股"rst2.Open strsql2,cnn2For i=1To rst2.Fields.CountSheets("报表").Cells(3,i+19)=rst2.Fields(i-1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rst2rst2.Closecnn2.CloseSet rst2=NothingSet cnn2=NothingDim strsql3As StringDim cnn3As New ADODB.ConnectionDim rst3As New ADODB.Recordsetcnn3.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql3="SELECT单位,类,款,sum(专业股)as专业股,sum(预算股)as预算股from[报表$t3:y10000]group by单位,类,款order by单位desc"rst3.Open strsql3,cnn3For i=1To rst3.Fields.CountSheets("报表").Cells(3,i+26)=rst3.Fields(i-1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3=NothingSet cnn3=NothingDim strsql4As StringDim cnn4As New ADODB.ConnectionDim rst4As New ADODB.Recordsetcnn4.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql4="SELECT单位,类,sum(专业股)as专业股,sum(预算股)as预算股from[报表$t3:y10000] group by单位,类order by单位desc"rst4.Open strsql4,cnn4For i=1To rst4.Fields.CountSheets("报表").Cells(3,i+32)=rst4.Fields(i-1).NameNext iSheets("报表").Range("ag4").CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4=NothingSet cnn4=NothingDim strsql5As StringDim cnn5As New ADODB.ConnectionDim rst5As New ADODB.Recordsetcnn5.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql5="SELECT单位,sum(专业股)as专业股,sum(预算股)as预算股from[报表$t3:y10000] group by单位order by单位desc"rst5.Open strsql5,cnn5For i=1To rst5.Fields.CountSheets("报表").Cells(3,i+37)=rst5.Fields(i-1).NameNext iSheets("报表").Range("al4").CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5=NothingSet cnn5=NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightRange("ad3")="项"Columns("Aj:Ak").SelectSelection.Insert Shift:=xlToRightRange("aj3")="款"Range("ak3")="项"Columns("Ap:Ar").SelectSelection.Insert Shift:=xlToRightRange("ap3")="类"Range("aq3")="款"Range("ar3")="项"Dim strsql6As StringDim cnn6As New ADODB.ConnectionDim rst6As New ADODB.Recordsetcnn6.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql6="SELECT单位,类,款,项,专业股,预算股from[报表$t3:y10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$aa3:af10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$ah3:am10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$ao3:at10000]order by单位desc,类,款,项"rst6.Open strsql6,cnn6For i=1To rst6.Fields.CountSheets("报表").Cells(3,i)=rst6.Fields(i-1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6=NothingSet cnn6=NothingRange("j1:au10000").ClearContentsDim p As LongDim prow As Longprow=Range("a3").End(xlDown).RowFor p=4To prowRange("g3")="金额"Cells(p,7)=VBA.Round(Cells(p,6)-Cells(p,5),2)Next pApplication.ScreenUpdating=TrueEnd Sub2、分开写代码：Sub连接()Application.ScreenUpdating=FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT月,归口,股,单位,类,款,项,sum(指标数)as指标数from[专业$a3:h10000]group by月,归口,股,单位,类,款,项union all SELECT月,归口,股,单位,类,款,项,sum(指标数)as指标数from[预算$a3:l10000]group by月,归口,股,单位,类,款,项order by股desc"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i+9)=rst.Fields(i-1).NameNext iSheets("报表").Range("j4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=TrueEnd SubSub项()Application.ScreenUpdating=FalseCall连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="transform sum(指标数)SELECT单位,类,款,项from[报表$j3:q10000]where归口='" &Range("g2").Value&"'and月<="&Range("h2").Value&"group by单位,类,款,项pivot股"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i+19)=rst.Fields(i-1).NameNext iSheets("报表").Range("t4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=TrueEnd SubSub款()Application.ScreenUpdating=FalseCall项Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,类,款,sum(专业股)as专业股,sum(预算股)as预算股from[报表$t3:y10000]group by单位,类,款"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i+26)=rst.Fields(i-1).NameNext iSheets("报表").Range("aa4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingColumns("AD:AD").SelectSelection.Insert Shift:=xlToRightCells(3,30)="项"Application.ScreenUpdating=TrueEnd SubSub类()Application.ScreenUpdating=FalseCall款Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,类,sum(专业股)as专业股,sum(预算股)as预算股from[报表$aa3:af10000]group by单位,类"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i+33)=rst.Fields(i-1).NameNext iSheets("报表").Range("ah4").CopyFromRecordset rstrst.CloseSet rst=NothingSet cnn=NothingColumns("AJ:AJ").SelectSelection.Insert Shift:=xlToRightColumns("AK:AK").SelectSelection.Insert Shift:=xlToRightRange("AJ3").SelectActiveCell.FormulaR1C1="款"Range("AK3").SelectActiveCell.FormulaR1C1="项"Application.ScreenUpdating=TrueEnd SubSub单位()Application.ScreenUpdating=FalseCall类Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,sum(专业股)as专业股,sum(预算股)as预算股from[报表$ah3:am10000] group by单位"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i+40)=rst.Fields(i-1).NameNext iSheets("报表").Range("ao4").CopyFromRecordset rstcnn.CloseSet rst=NothingSet cnn=NothingApplication.ScreenUpdating=True Columns("AP:AP").SelectSelection.Insert Shift:=xlToRightColumns("AQ:AQ").SelectSelection.Insert Shift:=xlToRightColumns("AR:AR").SelectSelection.Insert Shift:=xlToRightRange("AP3").SelectActiveCell.FormulaR1C1="类"Range("AQ3").SelectActiveCell.FormulaR1C1="款"Range("AR3").SelectActiveCell.FormulaR1C1="项" End SubSub报表()If Range("i2")="类"ThenCall类ElseIf Range("i2")="款"ThenCall款ElseCall项End IfEnd SubSub总报表()Application.ScreenUpdating=FalseCall单位Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel8.0;Hdr=Yes';Data Source="&ThisWorkbook.FullNamestrsql="SELECT单位,类,款,项,专业股,预算股from[报表$t3:y10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$aa3:af10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$ah3:am10000]union all SELECT单位,类,款,项,专业股,预算股from[报表$ao3:at10000]order by单位desc,类,款,项"rst.Open strsql,cnnFor i=1To rst.Fields.CountSheets("报表").Cells(3,i)=rst.Fields(i-1).NameNext iSheets("报表").Range("a4").CopyFromRecordset rstrst.Closecnn.CloseSet rst=NothingSet cnn=NothingRange("j1:br10000").ClearApplication.ScreenUpdating=TrueEnd Sub插入图片Sub按钮48_单击()宏按钮名，编码时自动生成On Error Resume NextDim MR As RangeFor Each MR In SelectionIf Not IsEmpty(MR)ThenMR.SelectML=MR.LeftMT=MR.TopMW=MR.WidthMH=MR.HeightActiveSheet.Shapes.AddShape(msoShapeRectangle,ML,MT, MW,MH).SelecterPicture_ActiveWorkbook.Path&"\pic\"&MR.Value&".jpg"End IfNextEnd Sub图片所在的文件夹，图片名称格式与EXCEL表在同一个文件夹里，。

VBA编程中的常用代码VBA（Visual Basic for Applications）是一种编程语言，用于在Microsoft Office应用程序中编写自定义宏和功能。

以下是一些在VBA 编程中常常用到的代码片段和技巧。

1. Excel VBA：打开和关闭工作簿这段代码演示了如何在Excel VBA中打开和关闭一个工作簿。

```vbaSub OpenAndCloseWorkbookDim wb As WorkbookSet wb = Workbooks.Open("C:\Path\To\Your\File.xlsx")'在这里执行你的代码wb.Close SaveChanges:=FalseEnd Sub```2. Excel VBA：遍历工作表下面的代码展示了如何遍历一个Excel工作簿中的所有工作表。

```vbaSub LoopThroughWorksheetsDim ws As WorksheetFor Each ws In ThisWorkbook.Worksheets'在这里执行你的代码Next wsEnd Sub```3. Excel VBA：在工作表中查找特定值以下代码展示了如何在一个工作表中查找特定值并返回它的位置。

```vbaFunction FindValue(ByRef rng As Range, ByVal searchValue As String) As RangeDim cell As RangeSet FindValue = NothingFor Each cell In rngIf cell.Value = searchValue ThenSet FindValue = cellExit FunctionEnd IfNext cellEnd Function```4. Word VBA：插入文本以下代码演示了如何在Word文档中插入文本。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解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。