EXCEL常用宏

EXCEL259个常用宏宏文件集打开全部隐藏工作表Sub打开全部隐藏工作表()DimiAsIntegerFori=1ToSheets.CountSheets(i).Visible=TrueNextiEndSub循环宏Sub循环()AAA=Range(C2)DimiAsLongDimtimesAsLongtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)Fori=1TotimesCall过滤一行IfRange(完成标志)=完成ThenExitFor'如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'IfSheets(传送参数).Range(A&i).Text=完成ThenExitFor'如果某列出现完成内容则退出循环NextiEndSub录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()Application.CommandBars(StopRecording).Visible=TrueEndSub高级筛选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_:=xlPinYinEndSub双击单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange($A$1)=关闭ThenExitSubSelectCaseTarget.AddressCase$A$4Call宏1Cancel=TrueCase$B$4Call宏2Cancel=TrueCase$C$4Call宏3Cancel=TrueCase$E$4Call宏4Cancel=TrueEndSelectEndSub双击指定区域单元执行宏(工作表代码)PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange($A$1)=关闭ThenExitSubIfNotApplication.Intersect(Target,Range(A4:A9,C4:C9))IsNothingThenCall打开隐藏表EndSub进入单元执行宏(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'以单元格进入代替按钮对象调用宏IfRange($A$1)=关闭ThenExitSubSelectCaseTarget.AddressCase$A$5'单元地址(Target.Address),或命名单元名字(Target.Name)Call宏1Case$B$5Call宏2Case$C$5Call宏3EndSelectEndSub进入指定区域单元执行宏(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange($A$1)=关闭ThenExitSubIfNotApplication.Intersect(Target,Range(A4:A9,C4:C9))IsNothingThenCall打开隐藏表EndSub在多个宏中依次循环执行一个（控件按钮代码）PrivateSubCommandButton1_Click()StaticRunMacroAsIntegerSelectCaseRunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0EndSelectEndSub在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()WithCommandButton1If.Caption=保护工作表ThenCall保护工作表.Caption=取消工作表保护ExitSubEndIfIf.Caption=取消工作表保护ThenCall取消工作表保护.Caption=保护工作表ExitSubEndIfEndWithEndSub在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）OptionExplicitPrivateSubCommandButton1_Click()WithCommandButton1If.Caption=宏1ThenCall宏1.Caption=宏2ExitSubEndIfIf.Caption=宏2ThenCall宏2.Caption=宏3ExitSubEndIfIf.Caption=宏3ThenCall宏3.Caption=宏1ExitSubEndIfEndWithEndSub根据A1单元文本隐藏/显示按钮（控件按钮代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange(A1)2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0EndIfEndSubPrivateSubCommandButton1_Click()重排窗口EndSub当前单元返回按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()ActiveCell=CommandButton1.CaptionEndSub当前单元内容返回到按钮名称（控件按钮代码）PrivateSubCommandButton1_Click()CommandButton1.Caption=ActiveCellEndSub奇偶页分别打印Sub奇偶页分别打印()Dimi%,Ps%Ps=ExecuteExcel4Macro(GET.DOCUMENT(50))'总页数MsgBox现在打印奇数页,按确定开始.Fori=1ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiMsgBox现在打印偶数页,按确定开始.Fori=2ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiEndSub自动打印多工作表第一页Sub自动打印多工作表第一页()DimshAsIntegerDimxDimyDimsyDimsyzx=InputBox(请输入起始工作表名字:)sy=InputBox(请输入结束工作表名字:)y=Sheets(x).Indexsyz=Sheets(sy).IndexForsh=yTosyzSheets(sh).SelectSheets(sh).PrintOutfrom:=1,To:=1NextshEndSub查找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将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返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange(A1)=xEndSub在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEndSub返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBoxtEndSub返回光标选择区域的行数和列数Sub返回光标选择区域的行数和列数()x=Selection.Rows.County=Selection.Columns.CountRange(A1)=xRange(A2)=yEndSub工作表中包含数据的最大行数Sub包含数据的最大行数()n=Cells.Find(*,,,,1,2).RowMsgBoxnEndSub返回A列数据的最大行数Sub返回A列数据的最大行数()n=Range(a65536).End(xlUp).RowRange(B1)=nEndSub将所选区域文本插入新建文本框Sub将所选区域文本插入新建文本框()ForEachragInSelectionn=n&rag.Value&Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal,ActiveCell.Left+ActiveCell.Width,ActiveCell.Top+ActiveCell.Height,250#,100).SelectSelection.Characters.Text=问题：&nWithSelection.Characters(Start:=1,Length:=3).Font.Name=黑体.FontStyle=常规.Size=12EndWithEndSub批量插入地址批注Sub批量插入地址批注()OnErrorResumeNextDimrAsRangeIfSelection.Cells.Count0ThenForEachrInSelectionr.Comment.Deleter.AddCommentr.Comment.Visible=Falser.Comment.TextText:=本单元格：&r.Address&of&Selection.AddressNextEndIfEndSub批量插入统一批注Sub