宏代碼齊全完整版本

,宏文件集,

▲,打開全部隱藏工作表,返回

,Sub打開全部隱藏工作表(),

,DimiAsInteger,

,Fori=1ToSheets.Count,

,Sheets(i).Visible=True,

,Nexti,

,EndSub,

,,,

▲,循環(huán)宏,返回

,Sub循環(huán)(),

,"AAA=Range(""C2"")",

,,

,DimiAsLong,

,DimtimesAsLong,

,times=AAA,

,'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可(不可小于1，不可大于2147483647),

,Fori=1Totimes,

,Call過濾一行,

,"IfRange(""完成標(biāo)志"")=""完成""ThenExitFor'如果名為'完成標(biāo)志'的命名單元的值等于'完成',則退出循環(huán),如果一開始就等于'完成',則只執(zhí)行一次循環(huán)就退出",

,"'IfSheets(""傳送參數(shù)"").Range(""A""&i).Text=""完成""ThenExitFor'如果某列出現(xiàn)""完成""內(nèi)容則退出循環(huán)",

,Nexti,

,EndSub,

▲,高級篩選5列不重復(fù)數(shù)據(jù)至指定表,返回

,Sub高級篩選5列不重復(fù)數(shù)據(jù)至Sheet2(),

,"Sheets(""Sheet2"").Range(""A1:E65536"")=""""'清除Sheet2的A:D列",

,"Range(""A1:E65536"").AdvancedFilterAction:=xlFilterCopy,CopyToRange:=Sheet2.Range(_",

,"""A1""),Unique:=True",

,"Sheet2.Columns(""A:E"").SortKey1:=Sheet2.Range(""A2""),Order1:=xlAscending,Header:=xlGuess,_",

,"OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_",

,:=xlPinYin,

,EndSub,

▲,在多個宏中依次循環(huán)執(zhí)行一個（控件按鈕代碼）,返回

,PrivateSubCommandButton1_Click(),

,StaticRunMacroAsInteger,

,SelectCaseRunMacro,

,Case0,

,宏1,

,RunMacro=1,

,Case1,

,宏2,

,RunMacro=2,

,Case2,

,宏3,

,RunMacro=0,

,EndSelect,

,EndSub,

▲,在兩個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）,返回

,PrivateSubCommandButton1_Click(),

,WithCommandButton1,

,"If.Caption=""保護工作表""Then",

,Call保護工作表,

,".Caption=""取消工作表保護""",

,ExitSub,

,EndIf,

,"If.Caption=""取消工作表保護""Then",

,Call取消工作表保護,

,".Caption=""保護工作表""",

,ExitSub,

,EndIf,

,EndWith,

,EndSub,

▲,在三個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）,返回

,OptionExplicit,

,PrivateSubCommandButton1_Click(),

,WithCommandButton1,

,"If.Caption=""宏1""Then",

,Call宏1,

,".Caption=""宏2""",

,ExitSub,

,EndIf,

,"If.Caption=""宏2""Then",

,Call宏2,

,".Caption=""宏3""",

,ExitSub,

,EndIf,

,"If.Caption=""宏3""Then",

,Call宏3,

,".Caption=""宏1""",

,ExitSub,

,EndIf,

,EndWith,

,EndSub,

▲,根據(jù)A1單元文本隱藏/顯示按鈕（控件按鈕代碼）,返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,"IfRange(""A1"")>2Then",

,CommandButton1.Visible=1,

,Else,

,CommandButton1.Visible=0,

,EndIf,

,EndSub,

,PrivateSubCommandButton1_Click(),

,重排窗口,

,EndSub,

▲,奇偶頁分別打印,返回

,Sub奇偶頁分別打印(),

,"Dimi%,Ps%",

,"Ps=ExecuteExcel4Macro(""GET.DOCUMENT(50)"")'總頁數(shù)",

,"MsgBox""現(xiàn)在打印奇數(shù)頁,按確定開始.""",

,Fori=1ToPsStep2,

,"ActiveSheet.PrintOutfrom:=i,To:=i",

,Nexti,

,"MsgBox""現(xiàn)在打印偶數(shù)頁,按確定開始.""",

,Fori=2ToPsStep2,

,"ActiveSheet.PrintOutfrom:=i,To:=i",

,Nexti,

,EndSub,

▲,自動打印多工作表第一頁,返回

,Sub自動打印多工作表第一頁(),

,DimshAsInteger,

,Dimx,

,Dimy,

,Dimsy,

,Dimsyz,

,"x=InputBox(""請輸入起始工作表名字:"")",

,"sy=InputBox(""請輸入結(jié)束工作表名字:"")",

,y=Sheets(x).Index,

,syz=Sheets(sy).Index,

,Forsh=yTosyz,

,Sheets(sh).Select,

,"Sheets(sh).PrintOutfrom:=1,To:=1",

,Nextsh,

,EndSub,

▲,查找A列文本循環(huán)插入分頁符,返回

,Sub循環(huán)插入分頁符(),

,"'Selection=Workbooks(""臨時表"").Sheets(""表2"").Range(""A1"")調(diào)用指定地址內(nèi)容",

,,

,DimiAsLong,

,DimtimesAsLong,

,"times=Application.WorksheetFunction.CountIf(Sheet1.Range(""a:a""),""分頁"")",

,'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可(不可小于1，不可大于2147483647),

,Fori=1Totimes,

,Call插入分頁符,

,Nexti,

,EndSub,

,Sub插入分頁符(),

,"Cells.Find(What:=""分頁"",After:=ActiveCell,LookIn:=xlValues,LookAt:=_",

,"xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_",

,.Activate,

,ActiveWindow.SelectedSheets.HPageBreaks.AddBefore:=ActiveCell,

,EndSub,

,Sub取消原分頁(),

,Cells.Select,

,ActiveSheet.ResetAllPageBreaks,

,EndSub,

▲,將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小,返回

,Sub將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小(),

,"DimPicAsPicture,i&",

,i=[A65536].End(xlUp).Row,

,ForEachPicInSheet1.Pictures,

,"IfNotApplication.Intersect(Pic.TopLeftCell,Range(""B1:B""&i))IsNothingThen",

,Pic.Top=Pic.TopLeftCell.Top,

,Pic.Left=Pic.TopLeftCell.Left,

,Pic.Height=Pic.TopLeftCell.Height,

,Pic.Width=Pic.TopLeftCell.Width,

,EndIf,

,Next,

,EndSub,

▲,返回光標(biāo)所在行數(shù),返回

,Sub返回光標(biāo)所在行數(shù)(),

,x=ActiveCell.Row,

,"Range(""A1"")=x",

,EndSub,

▲,工作表中包含數(shù)據(jù)的最大行數(shù),返回

,Sub包含數(shù)據(jù)的最大行數(shù)(),

,"n=Cells.Find(""*"",,,,1,2).Row",

,MsgBoxn,

,EndSub,

▲,返回A列數(shù)據(jù)的最大行數(shù),返回

,Sub返回A列數(shù)據(jù)的最大行數(shù)(),

,"n=Range(""a65536"").End(xlUp).Row",

,"Range(""B1"")=n",

,EndSub,

▲,將所選區(qū)域文本插入新建文本框,返回

,Sub將所選區(qū)域文本插入新建文本框(),

,ForEachragInSelection,

,n=n&rag.Value&Chr(10),

,Next,

,"ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal,ActiveCell.Left+ActiveCell.Width,ActiveCell.Top+ActiveCell.Height,250#,100).Select",

,"Selection.Characters.Text=""問題：""&n",

,"WithSelection.Characters(Start:=1,Length:=3).Font",

,".Name=""黑體""",

,".FontStyle=""常規(guī)""",

,.Size=12,

,EndWith,

,EndSub,

▲,批量插入地址批注,返回

,Sub批量插入地址批注(),

,OnErrorResumeNext,

,DimrAsRange,

,IfSelection.Cells.Count>0Then,

,ForEachrInSelection,

,r.Comment.Delete,

,r.AddComment,

,r.Comment.Visible=False,

,"r.Comment.TextText:=""本單元格：""&r.Address&""of""&Selection.Address",

,Next,

,EndIf,

,EndSub,

,,,

▲,批量插入統(tǒng)一批注,返回

,Sub批量插入統(tǒng)一批注(),

,"DimrAsRange,msgAsString",

,"msg=InputBox(""請輸入欲批量插入的批注"",""提示"",""隨便輸點什么吧"")",

,IfSelection.Cells.Count>0Then,

,ForEachrInSelection,

,r.AddComment,

,r.Comment.Visible=False,

,r.Comment.TextText:=msg,

,Next,

,EndIf,

,EndSub,

,,,

▲,以A1單元內(nèi)容批量插入批注,返回

,Sub以A1單元內(nèi)容批量插入批注(),

,DimrAsRange,

,IfSelection.Cells.Count>0Then,

,ForEachrInSelection,

,r.AddComment,

,r.Comment.Visible=False,

,r.Comment.TextText:=[a1].Text,

,Next,

,EndIf,

,EndSub,

▲,以A1單元文本作表名插入工作表,返回

,Sub以A1單元文本作表名插入工作表(),

,DimnmAsString,

,nm=[a1],

,Sheets.Add,

,ActiveSheet.Name=nm,

,EndSub,

,,,

▲,批量插入當(dāng)前文件名和表名及地址,返回

,Sub批量插入當(dāng)前文件名和表名及地址(),

,ForEachmycellInSelection,

,"mycell.FormulaR1C1=""[""+ActiveWorkbook.Name+""]""+ActiveSheet.Name+""!""+mycell.Address",

,Next,

,EndSub,

▲,區(qū)域錄入當(dāng)前單元地址,返回

,Sub區(qū)域錄入當(dāng)前單元地址(),

,"Selection=""=ADDRESS(ROW(),COLUMN(),4,1)""",

,Selection.Copy,

,"Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,SkipBlanks_",

,":=False,Transpose:=False",

,EndSub,

▲,區(qū)域錄入當(dāng)前日期,返回

,Sub區(qū)域錄入當(dāng)前日期(),

,WithApplication,

,.Calculation=xlManual,

,.MaxChange=0.001,

,EndWith,

,ActiveWorkbook.PrecisionAsDisplayed=False,

,"Selection=""=TEXT(NOW(),""""yyyy-m-d"""")""",

,Selection.Copy,

,"Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,SkipBlanks_",

,":=False,Transpose:=False",

,Windows.ArrangeArrangeStyle:=xlCascade,

,Application.CutCopyMode=False,

,WithApplication,

,.Calculation=xlAutomatic,

,.MaxChange=0.001,

,EndWith,

,ActiveWorkbook.PrecisionAsDisplayed=False,

,EndSub,

▲,區(qū)域錄入當(dāng)前數(shù)字日期,返回

,Sub區(qū)域錄入當(dāng)前數(shù)字日期(),

,"Selection=""=VALUE(YEAR(TODAY())&RIGHT(MONTH(TODAY())+100,2)&RIGHT(DAY(TODAY())+100,2))""",

,Selection.Copy,

,"Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,SkipBlanks_",

,":=False,Transpose:=False",

,EndSub,

▲,區(qū)域錄入當(dāng)前日期和時間,返回

,Sub區(qū)域錄入當(dāng)前日期和時間(),

,WithApplication,

,.Calculation=xlManual,

,.MaxChange=0.001,

,EndWith,

,ActiveWorkbook.PrecisionAsDisplayed=False,

,"Selection=""=TEXT(NOW(),""""yyyy-m-dh:mm:ss"""")""",

,Selection.Copy,

,"Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,SkipBlanks_",

,":=False,Transpose:=False",

,Windows.ArrangeArrangeStyle:=xlCascade,

,Application.CutCopyMode=False,

,WithApplication,

,.Calculation=xlAutomatic,

,.MaxChange=0.001,

,EndWith,

,ActiveWorkbook.PrecisionAsDisplayed=False,

,EndSub,

▲,不連續(xù)區(qū)域錄入對勾,返回

,Sub批量錄入對勾(),

,"Selection.FormulaR1C1=""√""",

,EndSub,

▲,不連續(xù)區(qū)域錄入當(dāng)前文件名,返回

,Sub批量錄入當(dāng)前文件名(),

,Selection.FormulaR1C1=ThisWorkbook.Name,

,EndSub,

▲,不連續(xù)區(qū)域添加文本,返回

,Sub批量添加文本(),

,DimsAsRange,

,ForEachsInSelection,

,"s=s&""文本內(nèi)容""",

,Next,

,EndSub,

▲,不連續(xù)區(qū)域插入文本,返回

,Sub批量插入文本(),

,DimsAsRange,

,ForEachsInSelection,

,"s=""文本內(nèi)容""&s",

,Next,

,EndSub,

▲,從指定位置向下同時錄入多單元指定內(nèi)容,返回

,Sub從指定位置向下同時錄入多單元指定內(nèi)容(),

,Dimarr,

,"arr=Array(""1"",""2"",""13"",""25"",""46"",""12"",""0"",""20"")",

,"[B2].Resize(8,1)=Application.WorksheetFunction.Transpose(arr)",

,EndSub,

▲,按aa工作表A列的內(nèi)容排列工作表標(biāo)簽順序,返回

,Sub按aa工作表A列的內(nèi)容排列工作表標(biāo)簽順序(),

,"DimI%,str1$",

,,

,I=1,

,"Sheets(""aa"").Select",

,"DoWhileCells(I,1).Value<>""""",

,"str1=Trim(Cells(I,1).Value)",

,Sheets(str1).Select,

,Sheets(str1).Moveafter:=Sheets(I),

,I=I+1,

,"Sheets(""aa"").Select",

,,

,Loop,

,EndSub,

▲,刪除全部未選定工作表,返回

,Sub刪除全部未選定工作表(),

,"DimshtAsWorksheet,nAsInteger,iFlagAsBoolean",

,DimShtName()AsString,

,n=ActiveWindow.SelectedSheets.Count,

,ReDimShtName(1Ton),

,n=1,

,ForEachshtInActiveWindow.SelectedSheets,

,ShtName(n)=sht.Name,

,n=n+1,

,Next,

,Application.DisplayAlerts=False,

,ForEachshtInSheets,

,iFlag=False,

,Fori=1Ton-1,

,IfShtName(i)=sht.NameThen,

,iFlag=True,

,ExitFor,

,EndIf,

,Next,

,IfNotiFlagThensht.Delete,

,Next,

,Application.DisplayAlerts=True,

,EndSub,

▲,工作表標(biāo)簽排序,返回

,Sub工作表標(biāo)簽排序(),

,"DimiAsLong,jAsLong,numsAsLong,msgAsLong",

,"msg=MsgBox(""工作表按升序排列請選'是[Y]'.""&vbCrLf&vbCrLf&""工作表按降序排列請選'否[N]'"",vbYesNoCancel,""工作表排序"")",

,Ifmsg=vbCancelThenExitSub,

,nums=Sheets.Count,

,Ifmsg=vbYesThen'Sortascending,

,Fori=1Tonums,

,Forj=iTonums,

,IfUCase(Sheets(j).Name)<UCase(Sheets(i).Name)Then,

,Sheets(j).MoveBefore:=Sheets(i),

,EndIf,

,Nextj,

,Nexti,

,Else'Sortdescending,

,Fori=1Tonums,

,Forj=iTonums,

,IfUCase(Sheets(j).Name)>UCase(Sheets(i).Name)Then,

,Sheets(j).MoveBefore:=Sheets(i),

,EndIf,

,Nextj,

,Nexti,

,EndIf,

,EndSub,

▲,在目錄表建立本工作簿中各表鏈接目錄,返回

,Sub在目錄表建立本工作簿中各表鏈接目錄(),

,"Dims%,RngAsRange",

,OnErrorResumeNext,

,"Sheets(""目錄"").Activate",

,IfErr=0Then,

,"Sheets(""目錄"").UsedRange.Delete",

,Else,

,Sheets.Add,

,"ActiveSheet.Name=""目錄""",

,EndIf,

,,

,Fori=1ToSheets.Count,

,"IfSheets(i).Name<>""目錄""Then",

,s=s+1,

,"SetRng=Sheets(""目錄"").Cells(((s-1)Mod20)+1,(s-1)\20+1+1)",

,"Rng=Format(s,""0"")&"".""&Sheets(i).Name",

,"ActiveSheet.Hyperlinks.AddRng,""#""&Sheets(i).Name&""!A1"",ScreenTip:=Sheets(i).Name",

,EndIf,

,Next,

,,

,"Sheets(""目錄"").Range(""b:iv"").EntireColumn.ColumnWidth=20",

,EndSub,

▲,建立工作表文本目錄,返回

,Sub建立工作表文本目錄(),

,Sheets.Addbefore:=Sheets(1),

,"Sheets(1).Name=""目錄""",

,Fori=2ToSheets.Count,

,"Cells(i-1,1)=Sheets(i).Name",

,"'Sheets(1).Hyperlinks.AddCells(i-1,1),""#""&Sheets(i).Name&""!A1""'添加超鏈接",

,Next,

,EndSub,

▲,查另一文件的全部表名,返回

,Sub查另一文件的全部表名(),

,OnErrorResumeNext,

,Dimi%,

,DimshAsWorksheet,

,Application.ScreenUpdating=False,

,"Workbooks.OpenFilename:=ThisWorkbook.Path&""\2.xls""",

,"Windows(""1.xls"").Activate'當(dāng)前文件名稱",

,"Sheets(""Sheet1"").Select'當(dāng)前表名稱",

,i=1'將表名稱返回到第1行,

,"ForEachshInWorkbooks(""2.xls"").Worksheets",

,"Cells(i,1)=sh.Name'將表名稱返回到第1列",

,i=i+1'返回每個表名稱向下移動1行,

,Nextsh,

,"Windows(""2.xls"").Close'關(guān)閉對象文件",

,Application.ScreenUpdating=True,

,EndSub,

▲,當(dāng)前單元錄入計算機名,返回

,Sub當(dāng)前單元錄入計算機名(),

,"Selection=Environ(""COMPUTERNAME"")",

,"'Selection=Workbooks(""臨時表"").Sheets(""表2"").Range(""A1"")調(diào)用指定地址內(nèi)容",

,EndSub,

▲,當(dāng)前單元錄入計算機用戶名,返回

,Sub當(dāng)前單元錄入計算機用戶名(),

,"Selection=Environ(""Username"")",

,"'Selection=Workbooks(""臨時表"").Sheets(""表2"").Range(""A1"")調(diào)用指定地址內(nèi)容",

,EndSub,

▲,為指定工作表加指定密碼保護表,返回

,Sub為指定工作表加指定密碼保護表(),

,"Sheet10.ProtectPassword:=""123""",

,EndSub,

▲,在有密碼的工作表執(zhí)行代碼,返回

,Sub在有密碼的工作表執(zhí)行代碼(),

,"Sheets(""1"").UnprotectPassword:=123'假定表名為“1”，密碼為“123”打開工作表",

,"Range(""C:C"").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden=True'隱藏C列空值行",

,"Sheets(""1"").ProtectPassword:=123'重新用密碼保護工作表",

,EndSub,

▲,拷貝A1公式和格式到A2,返回

,Sub拷貝A1公式到A2(),

,"Workbooks(""臨時表"").Sheets(""表1"").Range(""A1"").Copy",

,"Workbooks(""臨時表"").Sheets(""表2"").Range(""A2"").PasteSpecial",

,EndSub,

▲,復(fù)制單元數(shù)值,返回

,Sub復(fù)制數(shù)值(),

,"s=Workbooks(""book1"").Sheets(""Sheet1"").Range(""A1:A2"")",

,"Workbooks(""book2"").Sheets(""Sheet1"").Range(""A1:A2"")=s",

,EndSub,

▲,插入數(shù)值條件格式,返回

,Sub插入數(shù)值條件格式(),

,Selection.FormatConditions.Delete,

,"Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_",

,"Formula1:=""70""",

,Selection.FormatConditions(1).Interior.ColorIndex=45,

,"Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlLess,_",

,"Formula1:=""55""",

,Selection.FormatConditions(2).Interior.ColorIndex=39,

,"Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_",

,"Formula1:=""60""",

,Selection.FormatConditions(3).Interior.ColorIndex=34,

,EndSub,

▲,插入透明批注,返回

,Sub插入透明批注(),

,Selection.AddComment,

,Selection.Comment.Visible=False,

,DimXSAsWorksheet,

,Fori=1ToActiveSheet.Comments.Count,

,"ActiveSheet.Comments(i).Text""透明批注""",

,ActiveSheet.Comments(i).Shape.Fill.Visible=msoFalse,

,Next,

,EndSub,

▲,添加文本,返回

,Sub添加文本(),

,"Selection=Selection+""×""'不可在數(shù)字后添加文本",

,"'Selection=Workbooks(""臨時表"").Sheets(""表2"").Range(""A1"")調(diào)用指定地址內(nèi)容",

,EndSub,

▲,光標(biāo)定位到指定工作表A列最后數(shù)據(jù)行下一單元,返回

,Sub光標(biāo)定位到指定工作表A列最后數(shù)據(jù)行下一單元(),

,"a=Sheets(""數(shù)據(jù)庫"").[a65536].End(xlUp).Row",

,"Sheets(""數(shù)據(jù)庫"").Select",

,"Range(""A""&a+1).Select",

,EndSub,

▲,定位選定單元格式相同的全部單元格,返回

,Sub定位選定單元格式相同的全部單元格(),

,"DimFirstCellAsRange,FoundCellAsRange",

,DimAllCellsAsRange,

,WithApplication.FindFormat,

,.Clear,

,.NumberFormatLocal=Selection.NumberFormatLocal,

,.HorizontalAlignment=Selection.HorizontalAlignment,

,.VerticalAlignment=Selection.VerticalAlignment,

,.WrapText=Selection.WrapText,

,.Orientation=Selection.Orientation,

,.AddIndent=Selection.AddIndent,

,.IndentLevel=Selection.IndentLevel,

,.ShrinkToFit=Selection.ShrinkToFit,

,.MergeCells=Selection.MergeCells,

,.Font.Name=Selection.Font.Name,

,.Font.FontStyle=Selection.Font.FontStyle,

,.Font.Size=Selection.Font.Size,

,.Font.Strikethrough=Selection.Font.Strikethrough,

,.Font.Subscript=Selection.Font.Subscript,

,.Font.Underline=Selection.Font.Underline,

,.Font.ColorIndex=Selection.Font.ColorIndex,

,.Interior.ColorIndex=Selection.Interior.ColorIndex,

,.Interior.Pattern=Selection.Interior.Pattern,

,.Locked=Selection.Locked,

,.FormulaHidden=Selection.FormulaHidden,

,EndWith,

,,

,"SetFirstCell=ActiveSheet.UsedRange.Find(what:="""",searchformat:=True)",

,IfFirstCellIsNothingThen,

,ExitSub,

,EndIf,

,SetAllCells=FirstCell,

,SetFoundCell=FirstCell,

,,

,Do,

,"SetFoundCell=ActiveSheet.UsedRange.Find(After:=FoundCell,what:="""",searchformat:=True)",

,IfFoundCellIsNothingThenExitDo,

,"SetAllCells=Union(FoundCell,AllCells)",

,IfFoundCell.Address=FirstCell.AddressThenExitDo,

,Loop,

,AllCells.Select,

,EndSub,

▲,按當(dāng)前單元文本定位,返回

,Sub按當(dāng)前單元文本定位(),

,ABC=Selection,

,DimaaAsRange,

,ForEachaInActiveSheet.UsedRange,

,IfaLikeABCThen,

,IfaaIsNothingThen,

,Setaa=a.Cells,

,Else,

,"Setaa=Union(aa,a.Cells)",

,EndIf,

,EndIf,

,Next,

,aa.Select,

,EndSub,

▲,按固定文本定位,返回

,Sub文本定位(),

,DimaaAsRange,

,ForEachaInActiveSheet.UsedRange,

,"IfaLike""*合計*""Then",

,IfaaIsNothingThen,

,Setaa=a.Cells,

,Else,

,"Setaa=Union(aa,a.Cells)",

,EndIf,

,EndIf,

,Next,

,aa.Select,

,EndSub,

▲,刪除包含固定文本單元的行或列,返回

,Sub刪除包含固定文本單元的行或列(),

,Do,

,"Cells.Find(what:=""哈哈"").Activate",

,Selection.EntireRow.Delete'刪除行,

,'Selection.EntireColumn.Delete'刪除列,

,"LoopUntilCells.Find(what:=""哈哈"")IsNothing",

,EndSub,

▲,定位數(shù)據(jù)及區(qū)域以上的空值,返回

,Sub定位數(shù)據(jù)及區(qū)域以上的空值(),

,DimaaAsRange,

,ForEachaInActiveSheet.UsedRange,

,IfaLike〈0Then,

,IfaaIsNothingThen,

,Setaa=a.Cells,

,Else,

,"Setaa=Union(aa,a.Cells)",

,EndIf,

,EndIf,

,Next,

,aa.Select,

,EndSub,

▲,右側(cè)單元自動加5(工作表代碼),返回

,PrivateSubWorksheet_Change(ByValTargetAsRange),

,Application.EnableEvents=False,

,"Target.Offset(0,1)=Target+5",

,Application.EnableEvents=True,

,EndSub,

▲,當(dāng)前單元加2,返回

,Sub當(dāng)前單元加2(),

,Selection=Selection+2,

,"'Selection=Workbooks(""臨時表"").Sheets(""表2"").Range(""A1"")調(diào)用指定地址內(nèi)容",

,EndSub,

▲,A列等于A列減B列,返回

,SubA列等于A列減B列(),

,Fori=1To23,

,"Cells(i,1)=Cells(i,1)-Cells(i,2)",

,Next,

,EndSub,

▲,用于光標(biāo)選定多區(qū)域跳轉(zhuǎn)指定單元(工作表代碼),返回

,PrivateSubWorksheet_SelectionChange(ByValTAsRange),

,"a=Array([b6:b7],[e6],[h6])",

,Fori=0To2,

,"IfNotApplication.Intersect(T,a(i))IsNothingThen",

,[a1].Select:ExitFor,

,EndIf,

,Next,

,EndSub,

▲,將A1單元錄入的數(shù)據(jù)累加到B1單元（工作表代碼）,返回

,PrivateSubWorksheet_Change(ByValTargetAsRange),

,DimtAsLong,

,"IfTarget.Address=""$A$1""Then",

,"t=Sheet1.Range(""$B$1"").Value",

,"Sheet1.Range(""$B$1"").Value=t+Target.Value",

,EndIf,

,EndSub,

▲,"在指定顏色區(qū)域選擇單元時添加/取消""√""（工作表代碼）",返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,DimmyrgAsRange,

,ForEachmyrgInTarget,

,"Ifmyrg.Interior.ColorIndex=37Thenmyrg=IIf(myrg<>""√"",""√"","""")",

,Next,

,EndSub,

▲,"在指定區(qū)域選擇單元時添加/取消""√""（工作表代碼）",返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,DimRngAsRange,

,IfTarget.Count<=15Then,

,"IfNotApplication.Intersect(Target,Range(""D6:D20""))IsNothingThen",

,ForEachRngInSelection,

,WithRng,

,"If.Value=""""Then",

,".Value=""√""",

,Else,

,".Value=""""",

,EndIf,

,EndWith,

,Next,

,EndIf,

,EndIf,

,EndSub,

▲,雙擊指定單元，循環(huán)錄入文本（工作表代碼）,返回

,"PrivateSubWorksheet_BeforeDoubleClick(ByValTAsRange,CancelAsBoolean)",

,"IfT.Address<>""$A$1""ThenExitSub",

,Cancel=True,

,"T=IIf(T=""好"",""中"",IIf(T=""中"",""差"",""好""))",

,EndSub,

,雙擊指定單元，循環(huán)錄入文本（工作表代碼）,

,DimnumsAsByte,

,"PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)",

,"IfTarget.Address=""$A$1""Then",

,nums=numsMod3+1,

,"Target=Mid(""上中下"",nums,1)",

,"Target.Offset(1,0).Select",

,EndIf,

,EndSub,

▲,單元區(qū)域引用（工作表代碼）,返回

,PrivateSubWorksheet_Activate(),

,"Sheet1.Range(""A1:B3"").Value=Sheet2.Range(""A1:B3"").Value",

,EndSub,

,,,

▲,在指定區(qū)域選擇單元時數(shù)值加1（工作表代碼）,返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,"IfNotApplication.Intersect([a1:e10],Target)IsNothingThen",

,Target=Val(Target)+1,

,EndIf,

,EndSub,

▲,選擇單元區(qū)域觸發(fā)事件（工作表代碼）,返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,"IfTarget.Address=""$A$1:$B$2""Then",

,"MsgBox""你選擇了$A$1:$B$2單元""",

,EndIf,

,EndSub,

▲,當(dāng)修改指定單元內(nèi)容時自動執(zhí)行宏（工作表代碼）,返回

,PrivateSubWorksheet_Change(ByValTargetAsRange),

,"IfNotApplication.Intersect(Target,[B3:B4])IsNothingThen",

,重排窗口,

,EndIf,

,EndSub,

▲,雙擊單元隱藏該行（工作表代碼）,返回

,"PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)",

,Rows(Target.Row).Hidden=True,

,EndSub,

▲,高亮顯示行（工作表代碼）,返回

,PrivateSubWorksheet_SelectionChange(ByValTargetAsRange),

,Cells.Interior.ColorIndex=2,

,"Rows(""1:2"").Interior.ColorIndex=40'保持1至2行的顏色推薦39,22,40,",

,"Rows(Target.Row).Interior.ColorIndex=35'高亮推薦顏色35,20,24,34,37,40,15",

,EndSub,

▲,為指定工作表設(shè)置滾動范圍（工作簿代碼）,返回

,"PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)",

,"Sheet1.ScrollArea=""A1:M30""",

,EndSub,

▲,將全部工作表的A1單元作為單擊按鈕（工作簿代碼）,返回

,"PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)",

,"IfTarget.Address=""$A$1""Then",

,Call宏名,

,EndIf,

,EndSub,

▲,鬧鐘——到指定時間執(zhí)行宏（工作簿代碼）,返回

,PrivateSubWorkbook_Open(),

,"Application.OnTime(""11:45:00""),""提示1""",

,"Application.OnTime(""12:00:00""),""提示2""",

,EndSub,

▲,改變Excel界面標(biāo)題的宏（工作簿代碼）,返回

,PrivateSubWorkbook_Open(),

,"Application.Caption=""春節(jié)快樂""",

,EndSub,

▲,在指定工作表的指定單元返回光標(biāo)當(dāng)前多選區(qū)地址（工作簿代碼）,返回

,"PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)",

,"Worksheets(""表2"").Range(""A1"")=Target.Address(0,0)",

,EndSub,

▲,B列錄入數(shù)據(jù)時在A列返回記錄時間（工作表代碼）,返回

,PublicSubWorksheet_Change(ByValTargetAsRange),

,IfTarget.Column=2Then,

,"Target.Offset(,-1)=Now",

,EndIf,

,EndSub,

▲,每編輯一個單元保存文件,返回

,PrivateSubWorksheet_Change(ByValTargetAsRange),

,ThisWorkbook.Save,

,EndSub,

▲,指定允許編輯區(qū)域,返回

,Sub指定允許編輯區(qū)域(),

,"ActiveSheet.ScrollArea=""B8:G15""",

,EndSub,

▲,解除允許編輯區(qū)域限制,返回

,Sub解除允許編輯區(qū)域限制(),

,"ActiveSheet.ScrollArea=""""",

,EndSub,

▲,刪除A列為指定內(nèi)容的行,返回

,Sub刪除A列為指定內(nèi)容的行(),

,"Dima,bAsInteger",

,a=Sheet1.[a65536].End(xlUp).Row,

,Forb=aTo2Step-1,

,"IfCells(b,1).Value=""刪除""Then",

,Rows(b).Delete,

,EndIf,

,Next,

,EndSub,

▲,刪除A列非數(shù)字單元行,返回

,Sub刪除A列非數(shù)字單元行(),

,i=[a65536].End(xlUp).Row,

,"Range(""A1:A""&i).SpecialCells(xlCellTypeConstants,2).EntireRow.Delete",

,EndSub,

▲,有條件刪除當(dāng)前行,返回

,Sub有條件刪除當(dāng)前行(),

,"If[A1]=2Or[B1]=""刪除""Then",

,Selection.DeleteShift:=xlUp,

,EndIf,

,EndSub,

▲,選擇下一行,返回

,Sub選擇下一行(),

,"ActiveCell.Offset(1,0).Rows(""1:1"").EntireRow.Select",

,EndSub,

▲,選擇光標(biāo)或選區(qū)所在行,返回

,Sub選擇光標(biāo)或選區(qū)所在行(),

,Selection.EntireRow.Select,

,EndSub,

▲,選擇光標(biāo)或選區(qū)所在列,返回

,Sub選擇光標(biāo)或選區(qū)所在列(),

,Selection.EntireColumn.Select,

,EndSub,

▲,光標(biāo)定位到名稱指定位置,返回

,Sub定位(),

,"Application.GotoRange(Evaluate(""名稱""))",

,EndSub,

▲,選擇名稱定義的數(shù)據(jù)區(qū),返回

,Sub選擇名稱定義的數(shù)據(jù)區(qū)(),

,[數(shù)據(jù)區(qū)].Select'插入名稱要使用INDIRECT函數(shù),

,"'Range(""數(shù)據(jù)區(qū)"").Select或者",

,"'Sheet1.Range(""數(shù)據(jù)區(qū)"").Select或者",

,EndSub,

▲,將Sheet1的A列的非空值寫到Sheet2的A列,返回

,Sub將Sheet1的A列的非空值寫到Sheet2的A列(),

,"Sheet1.Columns(""A:A"").SpecialCells(2,23).SpecialCells(12).CopySheet2.[A1]",

,EndSub,

▲,將名稱1的數(shù)據(jù)寫到名稱2,返回

,SubMacro2(),

,"Range(""位置2"")=Range(""位置1"").Value",

,EndSub,

▲,單元反選,返回

,Sub單元反選(),

,Application.DisplayAlerts=False,

,Application.ScreenUpdating=False,

,"DimraddressAsString,taddressAsString",

,raddress=Selection.Address,

,taddress=ActiveSheet.UsedRange.Address,

,WithSheets.Add,

,.Range(taddress)=0,

,".Range(raddress)=""=0""",

,"raddress=.Range(taddress).SpecialCells(xlCellTypeConstants,1).Address",

,.Delete,

,EndWith,

,ActiveSheet.Range(raddress).Select,

,Application.ScreenUpdating=True,

,EndSub,

▲,調(diào)整選中對象中的文字,返回

,Sub調(diào)整選中對象中的文字(),

,'文字居中、自動調(diào)整大小,

,WithSelection,

,.HorizontalAlignment=xlCenter,

,.VerticalAlignment=xlCenter,

,.ReadingOrder=xlContext,

,.Orientation=xlHorizontal,

,.AutoSize=True,

,.AddIndent=False,

,EndWith,

,EndSub,

▲,去除指定范圍內(nèi)的對象,返回

,Sub去除指定范圍內(nèi)的對象(),

,

DimpAsShape,

,"

SetMy=Worksheets(""工作表名"")",

,

ForEachpInMy.Shapes,

,"

IfNotApplication.Intersect(p.TopLeftCell,Range(""范圍""))IsNothingThenp.Delete",

,

Next,

,EndSub,

▲,更新透視表數(shù)據(jù)項,返回

,SubDeleteMissingItems2002All(),

,'防止數(shù)據(jù)透視表中顯示無用的數(shù)據(jù)項,

,'在Excel2002或更高版本中,

,"'如果無用的數(shù)據(jù)項已經(jīng)存在,",

,'運行這個宏可以更新,

,DimptAsPivotTable,

,DimwsAsWorksheet,

,ForEachwsInActiveWorkbook.Worksheets,

,ForEachptInws.PivotTables,

,pt.PivotCache.MissingItemsLimit=xlMissingItemsNone,

,Nextpt,

,Nextws,

,EndSub,

▲,將全部工作表名稱寫到A列,返回

,Sub將全部表名稱寫到A列(),

,k=1,

,ForEachShtInSheets,

,"Cells(k+1,1)=Sht.Name'指定寫入的行和列",

,k=k+1,

,Next,

,EndSub,

▲,為當(dāng)前選定的多單元插入指定名稱,返回

,Sub為當(dāng)前選定的多單元插入指定名稱(),

,"Selection.Name=""臨時""",

,"ActiveWorkbook.Names.AddName:=""臨時"",RefersTo:=Selection'或者換用這行代碼也可以",

,EndSub,

▲,以指定區(qū)域為表目錄補充新表,返回

,Sub以指定區(qū)域為表目錄補充新表(),

,"DimdicAsObject,shAsWorksheet",

,"Dimarr,item",

,"arr=Range(""B1:BB1"")",

,"Setdic=CreateObject(""scripting.dictionary"")",

,ForEachshInThisWorkbook.Worksheets,

,"dic.Addsh.Name,""""",

,Next,

,ForEachitemInarr,

,"Ifitem<>""""AndNotdic.exists(Trim(item))Then",

,WithThisWorkbook.Worksheets.Add,

,.Name=item,

,EndWith,

,EndIf,

,Next,

,Setdic=Nothing,

,EndSub,

▲,按A列數(shù)據(jù)批量修改表名稱,返回

,Sub按A列數(shù)據(jù)批量修改表名稱(),

,Dimi%,

,Fori=1ToSheets.Count-1,

,"Sheets(i).Name=Cells(i+1,1).Text",

,Next,

,EndSub,

▲,清除剪貼板,返回

,Sub清除剪貼板(),

,Application.CutCopyMode=False,

,"Application.CommandBars(""TaskPane"").Visible=False",

,EndSub,

▲,批量清除軟回車,返回

,Sub批量清除軟回車(),

,'也可直接使用Alt+10或13替換,

,"Cells.ReplaceWhat:=Chr(10),Replacement:="""",LookAt:=xlPart,SearchOrder:=_",

,"xlByRows,MatchCase:=False,SearchFormat:=False,ReplaceFormat:=False",

,EndSub,

▲,當(dāng)前文件另存到指定目錄,返回

,Sub當(dāng)前激活文件另存到指定目錄(),

,"ActiveWorkbook.SaveAsFilename:=""E:\信件\""&ActiveWorkbook.Name",

,EndSub,

▲,另存指定文件名,返回

,Sub另存指定文件名(),

,"ActiveWorkbook.SaveAsThisWorkbook.Path&""\別名.xls""",

,EndSub,

▲,以本工作表名稱另存文件到當(dāng)前目錄,返回

,Sub以本工作表名稱另存文件到當(dāng)前目錄(),

,"ActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path&""\""&ActiveSheet.Name&"".xls""",

,EndSub,

▲,將本工作表單獨另存文件到Excel當(dāng)前默認目錄,返回

,Sub將本工作表單獨另存文件到Excel當(dāng)前默認目錄(),

,ActiveSheet.Copy,

,"ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name&"".xls""",

,EndSub,

▲,以活動工作表名稱另存文件到Excel當(dāng)前默認目錄,返回

,Sub以活動工作表名稱另存文件到Excel當(dāng)前默認目錄(),

,"ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name&"".xls"",FileFormat:=_",

,"xlNormal,Password:="""",WriteResPassword:="""",ReadOnlyRecommended:=False_",

,",CreateBackup:=False",

,EndSub,

▲,另存所有工作表為工作簿,返回

,Sub另存所有工作表為工作簿(),

,DimshtAsWorksheet,

,Application.ScreenUpdating=False,

,"ipath=ThisWorkbook.Path&""\""",

,ForEachshtInSheets,

,sht.Copy,

,"ActiveWorkbook.SaveAsipath&sht.Name&"".xls""'(工作表名稱為文件名）",

,"'ActiveWorkbook.SaveAsipath&sht.Name&Trim(sht.[d15])&"".xls""'（文件名稱&D15單元內(nèi)容）",

,"'ActiveWorkbook.SaveAsipath&Trim(sht.[d15])&"".xls""'（文件名稱為D15單元內(nèi)