vba实用代码大全(vba常用代码大全)

大家好，本篇文章为大家解答以上问题，相信很多人对vba实用代码大全都不是特别的了解，因此呢，今天就来为大家分享下关于vba实用代码大全以及vba常用代码大全的问题知识，还望可以帮助大家，解决大家的一些困惑，下面一起来看看吧！

本文目录一览

1、求VBA代码大全2、VBA-对应excel日常常用操作代码

求VBA代码大全

1：打开所有隐藏工作表2：循环宏3：录制宏时调用“停止录制”工具栏4：高级筛选5列不重复数据至指定表5：双击单元执行宏(工作表代码)6：双击指定区域单元执行宏(工作表代码)7：进入单元执行宏(工作表代码)8：进入指定区域单元执行宏(工作表代码)9：在多个宏中依次循知肢键环执行一个（控件按钮代码）10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）12：根据A1单元文本隐藏/显示按钮（控件按钮代码）13：当前单元返回按钮名称（控件按钮代码）14：当前单元内容返回到按钮名称（控件按钮代码）15：奇偶页分别打印16：自动打印多工作表第一页17：查找A列文本循环插入分页符18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小19：返回光标所在行数20：在A1返回当前选中单元格数量21：返回当前工作簿中工作表数量22：返回光标选择区域的行数和列数23：工作表中包含数据的最大行数24：返回A列数据的最大行数25：将所选区域文本插入新建文本框26：批量插入地址批注27：批量插入统一批注28：以A1单元内容批量插入批注29：不连续区域插入当前文件名和表名及地址30：不连续区域录入当前单元地址31：连续区域录入当前单元地址32：返回当前单元地址33：不连续区域录入当前日期34：不连续区域录入当前数字日期35：不连续区域录入当前日期和时间36：不连续区域录入对勾37：不连续区域录入当前文件名38：不连续区域添加文本39：不连续区域插入文本40：从指定位置向下同时录入多单元指定内容41：按aa工作表A列的内容排列工作表标签顺序42：以A1单元文本作表名插入工作表43：删除所有未选定工作表44：工作表标签排序45：定义指定工作表标签颜色46：在目录表建立本工作簿中各表链接目录47：建立工作表文本目录48：查另一文件的所有表名49：当前单元录入计算机名50：当前单元录入计算机用户名51：解除所有工作表保护52：为指定工作表加指定密码保护表53：在有密码的工作表执行代码54：执行前需要验证密码的宏(控件按钮代码)55：执行前需要验证密码的宏()56：拷贝A1公式和格式到A257：复制单元数值58：插入数值条件搭巧格式59：插入透明批注60：添加文本61：光标定位到指定工作表A列最后数据行下一单元62：定位选定单元格式相同的所有单元格63：按当前单元文本定位64：按固定文本定位65：删除包含固定文本单元的行或列66：定位数据及区域以上的空值67：右侧单元自动加5(工作表代码)68：当前单元加269：A列等于A列减B列70：用于光标选定多区域跳转指定单元(工作表代码)71：将A1单元录入的数据累加到B1单元（工作表代码）72：在指定颜色区域选择单元时添加/取消"√"（工作表代码）73：在指定区域选择单元时添加/取消"√"（工作表代码）74：双击指定单元，循环录入文本（工作表代码）75：双击指定单元，循环录入文本（工作表代码）76：单元区域引用（工作表代码）77：在指定区域选择单元时数值加1（工作表代码）78：混合文本的编号79：指定区域单元双击数据累加（工作表代码）80：选择单元区域触发事件（工作表代码）81：当修改指定单元内容时自动执行宏（工作表代码）82：被饥洞指定单元内容限制执行宏83：双击单元隐藏该行（工作表代码）84：高亮显示行（工作表代码）85：高亮显示行和列（工作表代码）86：为指定工作表设置滚动范围（工作簿代码）87：在指定单元记录打印和预览次数（工作簿代码）88：自动数字金额转大写（工作表代码）89：将所有工作表的A1单元作为单击按钮（工作簿代码）90：闹钟——到指定时间执行宏（工作簿代码）91：改变Excel界面标题的宏（工作簿代码）92：在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）93：B列录入数据时在A列返回记录时间（工作表代码）94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）95：指定单元显示光标位置内容（工作表代码）96：每编辑一个单元保存文件97：指定允许编辑区域98：解除允许编辑区域限制99：删除指定行100：删除A列为指定内容的行

1：打开所有隐藏工作表

Sub打开所有隐藏工作表()DimiAsIntegerFori=1ToSheets.CountSheets(i).Visible=TrueNextiEndSub

2：循环宏

Sub循环()

AAA=Range("C2")

DimiAsLongDimtimesAsLongtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)Fori=1TotimesCall过滤一行

IfRange("完成标志")="完成"ThenExitFor'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出

'IfSheets("传送参数").Range("A"&i).Text="完成"ThenExitFor'假如某列出现"完成"内容则退出循环NextiEndSub

3：录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()Application.CommandBars("StopRecording").Visible=TrueEndSub

4：高级筛选5列不重复数据至指定表Sub高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536")=""'清除Sheet2的A:D列Range("A1:E65536").AdvancedFilterAction:=xlFilterCopy,CopyToRange:=Sheet2.Range(_"A1"),Unique:=TrueSheet2.Columns("A:E").SortKey1:=Sheet2.Range("A2"),Order1:=xlAscending,Header:=xlGuess,_OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_:=xlPinYinEndSub5：双击单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange("$A$1")="关闭"ThenExitSubSelectCaseTarget.AddressCase"$A$4"Call宏1Cancel=TrueCase"$B$4"Call宏2Cancel=TrueCase"$C$4"Call宏3Cancel=TrueCase"$E$4"Call宏4Cancel=TrueEndSelectEndSub

6：双击指定区域单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange("$A$1")="关闭"ThenExitSubIfNotApplication.Intersect(Target,Range("A4:A9","C4:C9"))IsNothingThenCall打开隐藏表EndSub

7：进入单元执行宏(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'以单元格进入代替按钮对象调用宏IfRange("$A$1")="关闭"ThenExitSubSelectCaseTarget.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字(Target.Name)Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3EndSelectEndSub

8：进入指定区域单元执行宏(工作表代码)

PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange("$A$1")="关闭"ThenExitSubIfNotApplication.Intersect(Target,Range("A4:A9","C4:C9"))IsNothingThenCall打开隐藏表EndSub

9：在多个宏中依次循环执行一个（控件按钮代码）

PrivateSubCommandButton1_Click()StaticRunMacroAsIntegerSelectCaseRunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0EndSelectEndSub

10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()WithCommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"ExitSubEndIfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"ExitSubEndIfEndWithEndSub

11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）OptionExplicitPrivateSubCommandButton1_Click()WithCommandButton1If.Caption="宏1"ThenCall宏1.Caption="宏2"ExitSubEndIfIf.Caption="宏2"ThenCall宏2.Caption="宏3"ExitSubEndIfIf.Caption="宏3"ThenCall宏3.Caption="宏1"ExitSubEndIfEndWithEndSub12：根据A1单元文本隐藏/显示按钮（控件按钮代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0EndIfEndSubPrivateSubCommandButton1_Click()重排窗口EndSub

13：当前单元返回按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()ActiveCell=CommandButton1.CaptionEndSub

14：当前单元内容返回到按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()CommandButton1.Caption=ActiveCellEndSub

15：奇偶页分别打印Sub奇偶页分别打印()Dimi%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."Fori=1ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiMsgBox"现在打印偶数页,按确定开始."Fori=2ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiEndSub16：自动打印多工作表第一页Sub自动打印多工作表第一页()DimshAsIntegerDimxDimyDimsyDimsyzx=InputBox("请输入起始工作表名字:")sy=InputBox("请输入结束工作表名字:")y=Sheets(x).Indexsyz=Sheets(sy).IndexForsh=yTosyzSheets(sh).SelectSheets(sh).PrintOutfrom:=1,To:=1NextshEndSub

17：查找A列文本循环插入分页符Sub循环插入分页符()'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容DimiAsLongDimtimesAsLongtimes=Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"),"分页")'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)Fori=1TotimesCall插入分页符NextiEndSubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.AddBefore:=ActiveCellEndSubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEndSub

18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub将A列最后数据行以上的所有B列图片大小调整为所在单元大小()DimPicAsPicture,i&i=[A65536].End(xlUp).RowForEachPicInSheet1.PicturesIfNotApplication.Intersect(Pic.TopLeftCell,Range("B1:B"&i))IsNothingThenPic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEndIfNextEndSub

19：返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEndSub

20：在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEndSub

21：返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBoxtEndSub

93：B列录入数据时在A列返回记录时间（工作表代码）PublicSubWorksheet_Change(ByValTargetAsRange)IfTarget.Column=2ThenTarget.Offset(,-1)=NowEndIfEndSub

94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）PublicSubWorksheet_Change(ByValTargetAsRange)IfNotApplication.Intersect(Target,[A1:A1000])IsNothingThenIfTarget.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEndIfEndIfEndSub

PublicSubWorksheet_Change(ByValTargetAsRange)IfNotApplication.Intersect(Target,[A1:A1000])IsNothingThenIfTarget.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")EndIfEndIfEndSub

95：指定单元显示光标位置内容（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTAsRange)Sheets(1).Range("A1")=SelectionEndSub

96：每编辑一个单元保存文件PrivateSubWorksheet_Change(ByValTargetAsRange)ThisWorkbook.SaveEndSub

97：指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"EndSub

98：解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""EndSub

99：删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").DeleteEndSub

100：删除A列为指定内容的行Sub删除A列为指定内容的行()Dima,bAsIntegera=Sheet1.[a65536].End(xlUp).RowForb=aTo2Step-1IfCells(b,1).Value="删除"ThenRows(b).DeleteEndIfNextEndSub

VBA-对应excel日常常用操作代码

Sub fuzi() Range("a1:a22").Copy Range("b5").Select ActiveSheet.Paste '在选定区域进行粘贴(含格式)' Application.CutCopyMode = False ‘不带格式粘贴 Range("a1:a22").Copy Range("c5").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub Sub 运行多少秒() t = Timer lrow1 = Range("a1").CurrentRegion.Rows.Count lrow2 = Range("e1").CurrentRegion.Rows.Count Range("a2:a" & lrow1).Copy Range("e2:e" & lrow2).Select ActiveSheet.Paste Selection.NumberFormatLocal = "yyyy/m/d" ''-------------------------------------------- lrow3 = Range("b1").CurrentRegion.Rows.Count lrow4 = Range("f1").CurrentRegion.Rows.Count Range("b2:b" & lrow3).Copy Range("f2:f" & lrow4).Select ActiveSheet.Paste Selection.NumberFormatLocal = "0.00%" ''--------------------------------------------- lrow5 = Range("c1").CurrentRegion.Rows.Count lrow6 = Range("g1").CurrentRegion.Rows.Count Range("c2:c" & lrow5).Copy Range("g2:g" & lrow6).Select ActiveSheet.Paste Selection.NumberFormatLocal = "G/通用格式" ''--------------------------------------------- lrow7 = Range("d1").CurrentRegion.Rows.Count lrow8 = Range("h1").CurrentRegion.Rows.Count Range("d2:d" & lrow7).Copy Range("h2:f" & lrow8).Select ActiveSheet.Paste Selection.NumberFormatLocal = "@" MsgBox Timer - t & "秒完成" End Sub Sub 向右插燃困入一列() Worksheets("向右插入一列").Select Columns("d:d").Insert shift:=xlToRight End Sub Sub 取消隐藏() Worksheets("取消隐藏").Columns("b:h").EntireColumn.AutoFit '仅仅取消b - h列' 'Worksheets().UsedRange. EntireColumn.AutoFit'--整个表都取消 End Sub Sub 隐藏() Worksheets("隐藏").Select Columns("A:H").ColumnWidth = 0 End Sub Sub 判断统计() '等同于sumif功能' Worksheets("判断统计").Select Application.ScreenUpdating = False '关闭屏幕拿段租更新，看不到宏的执行过程，但提高消兆宏运行速度 Application.EnableEvents = False '关闭事件，防止触发事情，提高运行速度 a = Range("a1").CurrentRegion.Rows.Count For i = 2 To a If Range("p" & i) > 90 Then Range("u" & i) = "M3+" ElseIf Range("p" & i) >= 61 Then Range("u" & i) = "M3" ElseIf Range("p" & i) >= 31 Then Range("u" & i) = "M2" Else: Range("u" & i) = "M1" End If Next Range("Y21").Select ActiveCell.FormulaR1C1 = "=SUMIFS(C[-13],C[-5],""M1"")" Range("Y22").Select ActiveCell.FormulaR1C1 = "=SUMIFS(C[-13],C[-5],""M2"")" Range("Y23").Select ActiveCell.FormulaR1C1 = "=SUMIFS(C[-13],C[-5],""M3"")" Range("Y24").Select ActiveCell.FormulaR1C1 = "=SUMIFS(C[-13],C[-5],""M3+"")" Range("Z21").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-6],""M1"")" Range("Z22").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-6],""M2"")" Range("Z23").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-6],""M3"")" Range("Z24").Select ActiveCell.FormulaR1C1 = "=COUNTIF(C[-6],""M3+"")" Application.EnableEvents = True Application.ScreenUpdating = True '结束屏幕更新 End Sub Sub 匹配() Worksheets("匹配").Select Columns("K").Clear Range("K2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],C[-10]:C[-9],2,0)" Selection.AutoFill Destination:=Range("K2:K17"), Type:=xlFillDefault Range("K2:K17").Select Selection.Copy Range("K2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("M8").Select Application.CutCopyMode = False End Sub Sub 匹配1() Worksheets("匹配1").Select Columns("B").Clear Range("B2").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],被匹配!C[-1]:C,2,0)" Selection.AutoFill Destination:=Range("B2:B17"), Type:=xlFillDefault Range("B2:B17").Select Selection.Copy Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("M8").Select Application.CutCopyMode = False End Sub Sub 排序() Dim rng As Range Set rng = Range("A1:A22") rng.Sort key1:="CONTRACTNO", order1:=xlDescending, Header:=xlYes End Sub Sub 筛选() '筛选 irow = Range("a1").CurrentRegion.Rows.Count - 最大行 ActiveSheet.Range(" 1:A" & irow).AutoFilter field:=1, Criteria1:= _ "a15hhhhhhhhhh" '复制A16 Range("A16").Select Selection.Copy '在G16的位置粘贴 Range("G16").Select '带格式粘贴 ActiveSheet.Paste '退出粘贴 Application.CutCopyMode = False '退出筛选 ActiveSheet.Range(" 1:A" & irow).AutoFilter field:=1 End Sub Sub 判断分组() a = Range("a1").CurrentRegion.Rows.Count For i = 2 To 43 If Range("A" & i) = "M1-1" Then Range("D" & i) = Range("b" & i) / Range("c" & i) / 0.815 Else: Range("D" & i) = Range("b" & i) / Range("c" & i) / 0.095 End If Next End Sub Sub 单元格相对引用值() Range("A2").FormulaR1C1 = "=RC[1]&RC[2]" End Sub Sub 向下填充数据() Range("b2").Select ActiveCell.FormulaR1C1 = "=RC[-1]&""200""" Range("B2").Select Selection.AutoFill Destination:=Range("B2:B22"), Type:=xlFillDefault Range("B2:B22").Select End Sub Sub 表格显示隐藏() Worksheets("表格显示隐藏").Visible = True '打开隐藏表格' End Sub Sub 格式调整() lrow1 = Range("a1").CurrentRegion.Rows.Count lrow2 = Range("e1").CurrentRegion.Rows.Count Range("a2:a" & lrow1).Copy Range("e2:e" & lrow2).Select ActiveSheet.Paste Selection.NumberFormatLocal = "yyyy/m/d" ''-------------------------------------------- lrow3 = Range("b1").CurrentRegion.Rows.Count lrow4 = Range("f1").CurrentRegion.Rows.Count Range("b2:b" & lrow3).Copy Range("f2:f" & lrow4).Select ActiveSheet.Paste Selection.NumberFormatLocal = "0.00%" ''--------------------------------------------- lrow5 = Range("c1").CurrentRegion.Rows.Count lrow6 = Range("g1").CurrentRegion.Rows.Count Range("c2:c" & lrow5).Copy Range("g2:g" & lrow6).Select ActiveSheet.Paste Selection.NumberFormatLocal = "G/通用格式" ''--------------------------------------------- lrow7 = Range("d1").CurrentRegion.Rows.Count lrow8 = Range("h1").CurrentRegion.Rows.Count Range("d2:d" & lrow7).Copy Range("h2:h" & lrow8).Select ActiveSheet.Paste Selection.NumberFormatLocal = "@" End Sub Sub 透视表() Worksheets("透视表").Select Columns("J:L").Clear Columns("A:H").Select ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "透视表!R1C1:R20C8", Version:=xlPivotTableVersion15).CreatePivotTable _ TableDestination:="透视表!R4C10", TableName:="数据透视表1", DefaultVersion:= _ xlPivotTableVersion15 Sheets("透视表").Select Cells(4, 10).Select With ActiveSheet.PivotTables("数据透视表1").PivotFields("组别") .Orientation = xlRowField .Position = 1 End With ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _ ).PivotFields("可算回款金额"), "求和项:可算回款金额", xlSum ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _ ).PivotFields("是否有回退"), "求和项:是否有回退", xlSum With ActiveSheet.PivotTables("数据透视表1").PivotFields("求和项:是否有回退") .Caption = "计数项:是否有回退" .Function = xlCount End With ActiveWorkbook.ShowPivotTableFieldList = False End Sub