excel常用宏集合

1、1：打開所有隱藏工作表2：循環(huán)宏3：錄制宏時(shí)調(diào)用“停止錄制”工具欄4：高級篩選5列不重復(fù)數(shù)據(jù)至指定表5：雙擊單元執(zhí)行宏(工作表代碼6：雙擊指定區(qū)域單元執(zhí)行宏(工作表代碼7：進(jìn)入單元執(zhí)行宏(工作表代碼8：進(jìn)入指定區(qū)域單元執(zhí)行宏(工作表代碼9：在多個(gè)宏中依次循環(huán)執(zhí)行一個(gè)（控件按鈕代碼）10：在兩個(gè)宏中依次循環(huán)執(zhí)行一個(gè)并相應(yīng)修改按鈕名稱（控件按鈕代碼）11：在三個(gè)宏中依次循環(huán)執(zhí)行一個(gè)并相應(yīng)修改按鈕名稱（控件按鈕代碼）12：根據(jù)A1單元文本隱藏/顯示按鈕（控件按鈕代碼）13：當(dāng)前單元返回按鈕名稱（控件按鈕代碼）14：當(dāng)前單元內(nèi)容返回到按鈕名稱（控件按鈕代碼）15：奇偶頁分別打印16：自動(dòng)打印多工作表第

2、一頁17：查找A列文本循環(huán)插入分頁符18：將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小19：返回光標(biāo)所在行數(shù)20：在A1返回當(dāng)前選中單元格數(shù)量21：返回當(dāng)前工作簿中工作表數(shù)量22：返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)23：工作表中包含數(shù)據(jù)的最大行數(shù)24：返回A列數(shù)據(jù)的最大行數(shù)25：將所選區(qū)域文本插入新建文本框26：批量插入地址批注27：批量插入統(tǒng)一批注28：以A1單元內(nèi)容批量插入批注29：不連續(xù)區(qū)域插入當(dāng)前文件名和表名及地址30：不連續(xù)區(qū)域錄入當(dāng)前單元地址31：連續(xù)區(qū)域錄入當(dāng)前單元地址32：返回當(dāng)前單元地址33：不連續(xù)區(qū)域錄入當(dāng)前日期34：不連續(xù)區(qū)域錄入當(dāng)前數(shù)字日期35：不連續(xù)區(qū)域錄入當(dāng)前

3、日期和時(shí)間36：不連續(xù)區(qū)域錄入對勾37：不連續(xù)區(qū)域錄入當(dāng)前文件名38：不連續(xù)區(qū)域添加文本39：不連續(xù)區(qū)域插入文本40：從指定位置向下同時(shí)錄入多單元指定內(nèi)容41：按aa工作表A列的內(nèi)容排列工作表標(biāo)簽順序42：以A1單元文本作表名插入工作表43：刪除所有未選定工作表44：工作表標(biāo)簽排序45：定義指定工作表標(biāo)簽顏色46：在目錄表建立本工作簿中各表鏈接目錄47：建立工作表文本目錄48：查另一文件的所有表名49：當(dāng)前單元錄入計(jì)算機(jī)名50：當(dāng)前單元錄入計(jì)算機(jī)用戶名51：解除所有工作表保護(hù)52：為指定工作表加指定密碼保護(hù)表53：在有密碼的工作表執(zhí)行代碼54：執(zhí)行前需要驗(yàn)證密碼的宏(控件按鈕代碼55：執(zhí)行前需

4、要驗(yàn)證密碼的宏(56：拷貝A1公式和格式到A257：復(fù)制單元數(shù)值58：插入數(shù)值條件格式59：插入透明批注60：添加文本61：光標(biāo)定位到指定工作表A列最后數(shù)據(jù)行下一單元62：定位選定單元格式相同的所有單元格63：按當(dāng)前單元文本定位64：按固定文本定位65：刪除包含固定文本單元的行或列66：定位數(shù)據(jù)及區(qū)域以上的空值67：右側(cè)單元自動(dòng)加5(工作表代碼68：當(dāng)前單元加269：A列等于A列減B列70：用于光標(biāo)選定多區(qū)域跳轉(zhuǎn)指定單元(工作表代碼71：將A1單元錄入的數(shù)據(jù)累加到B1單元（工作表代碼）72：在指定顏色區(qū)域選擇單元時(shí)添加/取消""（工作表代碼）73：在指定區(qū)域選擇單元時(shí)添加/

5、取消""（工作表代碼）74：雙擊指定單元，循環(huán)錄入文本（工作表代碼）75：雙擊指定單元，循環(huán)錄入文本（工作表代碼）76：單元區(qū)域引用（工作表代碼）77：在指定區(qū)域選擇單元時(shí)數(shù)值加1（工作表代碼）78：混合文本的編號79：指定區(qū)域單元雙擊數(shù)據(jù)累加（工作表代碼）80：選擇單元區(qū)域觸發(fā)事件（工作表代碼）81：當(dāng)修改指定單元內(nèi)容時(shí)自動(dòng)執(zhí)行宏（工作表代碼）82：被指定單元內(nèi)容限制執(zhí)行宏83：雙擊單元隱藏該行（工作表代碼）84：高亮顯示行（工作表代碼）85：高亮顯示行和列（工作表代碼）86：為指定工作表設(shè)置滾動(dòng)范圍（工作簿代碼）87：在指定單元記錄打印和預(yù)覽次數(shù)（工作簿代碼）88：自動(dòng)

6、數(shù)字金額轉(zhuǎn)大寫（工作表代碼）89：將所有工作表的A1單元作為單擊按鈕（工作簿代碼）90：鬧鐘到指定時(shí)間執(zhí)行宏（工作簿代碼）91：改變Excel界面標(biāo)題的宏（工作簿代碼）92：在指定工作表的指定單元返回光標(biāo)當(dāng)前多選區(qū)地址（工作簿代碼）93：B列錄入數(shù)據(jù)時(shí)在A列返回記錄時(shí)間（工作表代碼）94：當(dāng)指定區(qū)域修改時(shí)在其右側(cè)的2個(gè)單元返回當(dāng)前日期和時(shí)間（工作表代碼）95：指定單元顯示光標(biāo)位置內(nèi)容（工作表代碼）96：每編輯一個(gè)單元保存文件97：指定允許編輯區(qū)域98：解除允許編輯區(qū)域限制99：刪除指定行100：刪除A列為指定內(nèi)容的行1：打開所有隱藏工作表Sub 打開所有隱藏工作表(Dim i As Integ

7、erFor i = 1 To Sheets.CountSheets(i.Visible = TrueNext iEnd Sub2：循環(huán)宏Sub 循環(huán)(AAA = Range("C2"Dim i As LongDim times As Longtimes = AAA'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可(不可小于1，不可大于2147483647For i = 1 To timesCall 過濾一行If Range("完成標(biāo)志" = "完成" Then Exit For '假如名為'完成標(biāo)志'

8、的命名單元的值等于'完成',則退出循環(huán),假如一開始就等于'完成',則只執(zhí)行一次循環(huán)就退出'If Sheets("傳送參數(shù)".Range("A" & i.Text = "完成" Then Exit For '假如某列出現(xiàn)"完成"內(nèi)容則退出循環(huán)Next iEnd Sub3：錄制宏時(shí)調(diào)用“停止錄制”工具欄Sub 錄制宏時(shí)調(diào)用停止錄制工具欄(Application.CommandBars("Stop Recording".Visible = Tru

9、eEnd Sub4：高級篩選5列不重復(fù)數(shù)據(jù)至指定表Sub 高級篩選5列不重復(fù)數(shù)據(jù)至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:=Sh

10、eet2.Range("A2", Order1:=xlAscending,Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYinEnd Sub5：雙擊單元執(zhí)行宏(工作表代碼Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As BooleanIf Range("$A$1" = "關(guān)閉" Then E

11、xit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4 Cancel = TrueEnd SelectEnd Sub6：雙擊指定區(qū)域單元執(zhí)行宏(工作表代碼Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Can

12、cel As BooleanIf Range("$A$1" = "關(guān)閉" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9", "C4:C9" Is Nothing Then Call 打開隱藏表End Sub7：進(jìn)入單元執(zhí)行宏(工作表代碼Private Sub Worksheet_SelectionChange(ByVal Target As Range'以單元格進(jìn)入代替按鈕對象調(diào)用宏If Range("$A$1&quo

13、t; = "關(guān)閉" Then Exit SubSelect Case Target.AddressCase "$A$5" '單元地址(Target.Address,或命名單元名字(Target.NameCall 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3 End SelectEnd Sub8：進(jìn)入指定區(qū)域單元執(zhí)行宏(工作表代碼Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Range("$

14、A$1" = "關(guān)閉" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9" Is Nothing Then Call 打開隱藏表End Sub9：在多個(gè)宏中依次循環(huán)執(zhí)行一個(gè)（控件按鈕代碼）Private Sub CommandButton1_Click(Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2

15、宏3RunMacro = 0End SelectEnd Sub10：在兩個(gè)宏中依次循環(huán)執(zhí)行一個(gè)并相應(yīng)修改按鈕名稱（控件按鈕代碼）Private Sub CommandButton1_Click(With CommandButton1If .Caption = "保護(hù)工作表" ThenCall 保護(hù)工作表.Caption = "取消工作表保護(hù)"Exit SubEnd IfIf .Caption = "取消工作表保護(hù)" ThenCall 取消工作表保護(hù).Caption = "保護(hù)工作表"Exit SubEnd IfEn

16、d WithEnd Sub11：在三個(gè)宏中依次循環(huán)執(zhí)行一個(gè)并相應(yīng)修改按鈕名稱（控件按鈕代碼）Option ExplicitPrivate 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"

17、ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub12：根據(jù)A1單元文本隱藏/顯示按鈕（控件按鈕代碼）Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Range("A1" > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click(重排窗口End Sub13

18、：當(dāng)前單元返回按鈕名稱（控件按鈕代碼）Private Sub CommandButton1_Click(ActiveCell = CommandButton1.CaptionEnd Sub14：當(dāng)前單元內(nèi)容返回到按鈕名稱（控件按鈕代碼）Private Sub CommandButton1_Click(CommandButton1.Caption = ActiveCellEnd Sub15：奇偶頁分別打印Sub 奇偶頁分別打印(Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50" '總頁數(shù)MsgBox "現(xiàn)

19、在打印奇數(shù)頁,按確定開始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "現(xiàn)在打印偶數(shù)頁,按確定開始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub16：自動(dòng)打印多工作表第一頁Sub 自動(dòng)打印多工作表第一頁(Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("請輸入起始工作表名字:"sy = Inpu

20、tBox("請輸入結(jié)束工作表名字:"y = Sheets(x.Indexsyz = Sheets(sy.IndexFor sh = y To syzSheets(sh.SelectSheets(sh.PrintOut from:=1, To:=1Next shEnd Sub17：查找A列文本循環(huán)插入分頁符Sub 循環(huán)插入分頁符(' Selection = Workbooks("臨時(shí)表".Sheets("表2".Range("A1" 調(diào)用指定地址內(nèi)容Dim i As LongDim times As Long

21、'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可(不可小于1，不可大于2147483647For i = 1 To timesCall 插入分頁符Next iEnd SubSub 插入分頁符(Cells.Find(What:="分頁", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _.ActivateEnd SubSub 取消原分頁(Cells.SelectActive

22、Sheet.ResetAllPageBreaksEnd Sub18：將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小Sub 將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小(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 ThenEnd IfNextEnd Sub19：返回光標(biāo)所在行數(shù)Sub 返

23、回光標(biāo)所在行數(shù)(x = ActiveCell.RowRange("A1" = xEnd Sub20：在A1返回當(dāng)前選中單元格數(shù)量Sub 在A1返回當(dāng)前選中單元格數(shù)量(A1 = Selection.CountEnd Sub21：返回當(dāng)前工作簿中工作表數(shù)量Sub 返回當(dāng)前工作簿中工作表數(shù)量(MsgBox tEnd Sub22：返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)Sub 返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)(Range("A1" = xRange("A2" = yEnd Sub23：工作表中包含數(shù)據(jù)的最大行數(shù)Sub 包含數(shù)據(jù)的最大行數(shù)(n = Cells.

24、Find("*", , , , 1, 2.RowMsgBox nEnd Sub24：返回A列數(shù)據(jù)的最大行數(shù)Sub 返回A列數(shù)據(jù)的最大行數(shù)(n = Range("a65536".End(xlUp.RowRange("B1" = nEnd Sub25：將所選區(qū)域文本插入新建文本框Sub 將所選區(qū)域文本插入新建文本框(For Each rag In Selectionn = n & rag.Value & Chr(10NextWith Selection.Characters(Start:=1, Length:=3.Font

25、.Name = "黑體".FontStyle = "常規(guī)".Size = 12End WithEnd Sub26：批量插入地址批注Sub 批量插入地址批注(On Error Resume NextDim r As RangeFor Each r In Selectionr.AddCommentNextEnd IfEnd Sub27：批量插入統(tǒng)一批注Sub 批量插入統(tǒng)一批注(Dim r As Range, msg As Stringmsg = InputBox("請輸入欲批量插入的批注", "提示", "隨

26、便輸點(diǎn)什么吧"For Each r In Selectionr.AddCommentNextEnd IfEnd Sub28：以A1單元內(nèi)容批量插入批注Sub 以A1單元內(nèi)容批量插入批注(Dim r As RangeFor Each r In Selectionr.AddCommentNextEnd IfEnd Sub29：不連續(xù)區(qū)域插入當(dāng)前文件名和表名及地址Sub 批量插入當(dāng)前文件名和表名及地址(For Each mycell In Selectionmycell.FormulaR1C1 = "" + ActiveWorkbook.Name + "&qu

27、ot; + ActiveSheet.Name + "!" + mycell.AddressNextEnd Sub30：不連續(xù)區(qū)域錄入當(dāng)前單元地址Sub 區(qū)域錄入當(dāng)前單元地址(For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub31：連續(xù)區(qū)域錄入當(dāng)前單元地址Sub 連續(xù)區(qū)域錄入當(dāng)前單元地址(Selection = "=ADDRESS(ROW(,COLUMN(,4,1"Selection.CopySelection.PasteSpecial Paste:=xlPa

28、steValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub32：返回當(dāng)前單元地址Sub 返回當(dāng)前單元地址(d = ActiveCell.AddressA1 = dEnd Sub33：不連續(xù)區(qū)域錄入當(dāng)前日期Sub 區(qū)域錄入當(dāng)前日期(Selection.FormulaR1C1 = Format(Now(, "yyyy-m-d"End Sub34：不連續(xù)區(qū)域錄入當(dāng)前數(shù)字日期Sub 區(qū)域錄入當(dāng)前數(shù)字日期(Selection.FormulaR1C1 = Format(Now(, "yy

29、yymmdd"End Sub35：不連續(xù)區(qū)域錄入當(dāng)前日期和時(shí)間Sub 區(qū)域錄入當(dāng)前日期和時(shí)間(Selection.FormulaR1C1 = Format(Now(, "yyyy-m-d h:mm:ss"End Sub36：不連續(xù)區(qū)域錄入對勾Sub 批量錄入對勾(Selection.FormulaR1C1 = ""End Sub37：不連續(xù)區(qū)域錄入當(dāng)前文件名Sub 批量錄入當(dāng)前文件名(Selection.FormulaR1C1 = ThisWorkbook.NameEnd Sub38：不連續(xù)區(qū)域添加文本Sub 批量添加文本(Dim s As R

30、angeFor Each s In Selections = s & "文本內(nèi)容"NextEnd Sub39：不連續(xù)區(qū)域插入文本Sub 批量插入文本(Dim s As RangeFor Each s In Selections = "文本內(nèi)容" & sNextEnd Sub40：從指定位置向下同時(shí)錄入多單元指定內(nèi)容Sub 從指定位置向下同時(shí)錄入多單元指定內(nèi)容(Dim arrarr = Array("1", "2", "13", "25", "46&q

31、uot;, "12", "0", "20"End Sub41：按aa工作表A列的內(nèi)容排列工作表標(biāo)簽順序Sub 按aa工作表A列的內(nèi)容排列工作表標(biāo)簽順序(Dim I%, str1$I = 1Sheets("aa".SelectDo While Cells(I, 1.Value <> ""str1 = Trim(Cells(I, 1.ValueSheets(str1.SelectSheets(str1.Move after:=Sheets(II = I + 1Sheets("a

32、a".SelectLoopEnd Sub42：以A1單元文本作表名插入工作表Sub 以A1單元文本作表名插入工作表(Dim nm As Stringnm = a1Sheets.AddActiveSheet.Name = nmEnd Sub43：刪除所有未選定工作表Sub 刪除所有未選定工作表(Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName( As StringReDim ShtName(1 To nn = 1For Each sht In ActiveWindow.SelectedSheetsShtNam

33、e(n = sht.Namen = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i = sht.Name TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub44：工作表標(biāo)簽排序Sub 工作表標(biāo)簽排序(Dim i As Long, j As Long, nums As Lo

34、ng, msg As Longmsg = MsgBox("工作表按升序排列請選 '是Y'. " & vbCrLf & vbCrLf & "工作表按降序排列請選 '否N'", vbYesNoCancel, "工作表排序"If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbYes Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(S

35、heets(j.Name < UCase(Sheets(i.Name ThenSheets(j.Move Before:=Sheets(iEnd IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j.Name > UCase(Sheets(i.Name ThenSheets(j.Move Before:=Sheets(iEnd IfNext jNext iEnd IfEnd Sub259個(gè)常用宏-excelhome(22009-08-15 14:11:45

36、 45：定義指定工作表標(biāo)簽顏色Sub 定義指定工作表標(biāo)簽顏色(Sheets("Sheet1".Tab.ColorIndex = 46End Sub46：在目錄表建立本工作簿中各表鏈接目錄Sub 在目錄表建立本工作簿中各表鏈接目錄(Dim s%, Rng As RangeOn Error Resume NextSheets("目錄".ActivateIf Err = 0 ThenSheets("目錄".UsedRange.DeleteElseSheets.AddActiveSheet.Name = "目錄"End I

37、fFor i = 1 To Sheets.CountIf Sheets(i.Name <> "目錄" Thens = s + 1Set Rng = Sheets("目錄".Cells(s - 1 Mod 20 + 1, (s - 1 20 + 1 + 1Rng = Format(s, " 0" & ". " & Sheets(i.NameEnd IfNextSheets("目錄".Range("b:iv".EntireColumn.ColumnWi

38、dth = 20End Sub47：建立工作表文本目錄Sub 建立工作表文本目錄(Sheets.Add before:=Sheets(1Sheets(1.Name = "目錄"For i = 2 To Sheets.CountCells(i - 1, 1 = Sheets(i.NameNextEnd Sub48：查另一文件的所有表名Sub 查另一文件的所有表名(On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=This

39、Workbook.Path & "2.xls"Windows("1.xls".Activate '當(dāng)前文件名稱Sheets("Sheet1".Select '當(dāng)前表名稱i = 1 '將表名稱返回到第1行For Each sh In Workbooks("2.xls".WorksheetsCells(i, 1 = sh.Name '將表名稱返回到第1列i = i + 1 '返回每個(gè)表名稱向下移動(dòng)1行Next shWindows("2.xls".Clo

40、se '關(guān)閉對象文件Application.ScreenUpdating = TrueEnd Sub49：當(dāng)前單元錄入計(jì)算機(jī)名Sub 當(dāng)前單元錄入計(jì)算機(jī)名(Selection = Environ("COMPUTERNAME"'Selection = Workbooks("臨時(shí)表".Sheets("表2".Range("A1" 調(diào)用指定地址內(nèi)容End Sub50：當(dāng)前單元錄入計(jì)算機(jī)用戶名Sub 當(dāng)前單元錄入計(jì)算機(jī)用戶名(Selection = Environ("Username"&

41、#39;Selection = Workbooks("臨時(shí)表".Sheets("表2".Range("A1" 調(diào)用指定地址內(nèi)容End Sub51：解除所有工作表保護(hù)Sub 解除所有工作表保護(hù)(Dim n As IntegerFor n = 1 To Sheets.CountSheets(n.UnprotectNext nEnd Sub52：為指定工作表加指定密碼保護(hù)表Sub 為指定工作表加指定密碼保護(hù)表(Sheet10.Protect Password:="123"End Sub53：在有密碼的工作表執(zhí)行代碼Sub

42、 在有密碼的工作表執(zhí)行代碼(Sheets("1".Unprotect Password:=123 '假定表名為“1”，密碼為“123” 打開工作表Sheets("1".Protect Password:=123 '重新用密碼保護(hù)工作表End Sub54：執(zhí)行前需要驗(yàn)證密碼的宏(控件按鈕代碼Private Sub CommandButton1_Click(If InputBox("請輸入密碼：" <> "123" Then '密碼是123MsgBox "密碼錯(cuò)誤,按確定退

43、出!", 64, "提示"Exit SubEnd IfCells(1, 1 = 10End Sub55：執(zhí)行前需要驗(yàn)證密碼的宏(Sub 執(zhí)行前需要驗(yàn)證密碼的宏(If InputBox("請輸入您的使用權(quán)限:", "系統(tǒng)提示" = 123 Then重排窗口 '要執(zhí)行的宏代碼或宏名稱ElseMsgBox "對不起,您沒有使用該宏的權(quán)限,按確定鍵后退出!"End IfEnd Sub56：拷貝A1公式和格式到A2Sub 拷貝A1公式到A2(Workbooks("臨時(shí)表".Sheets(

44、"表1".Range("A1".CopyWorkbooks("臨時(shí)表".Sheets("表2".Range("A2".PasteSpecialEnd Sub57：復(fù)制單元數(shù)值Sub 復(fù)制數(shù)值(s = Workbooks("book1".Sheets("Sheet1".Range("A1:A2"Workbooks("book2".Sheets("Sheet1".Range("A1:A2&q

45、uot; = sEnd Sub58：插入數(shù)值條件格式Sub 插入數(shù)值條件格式(Formula1:="70"Formula1:="55"Formula1:="60"End Sub59：插入透明批注Sub 插入透明批注(Selection.AddCommentDim XS As WorksheetActiveSheet.Comments(i.Text "透明批注"NextEnd Sub60：添加文本Sub 添加文本(Selection = Selection + "×" '不可在數(shù)

46、字后添加文本'Selection = Workbooks("臨時(shí)表".Sheets("表2".Range("A1" 調(diào)用指定地址內(nèi)容End Sub61：光標(biāo)定位到指定工作表A列最后數(shù)據(jù)行下一單元Sub 光標(biāo)定位到指定工作表A列最后數(shù)據(jù)行下一單元(a = Sheets("數(shù)據(jù)庫".a65536.End(xlUp.RowSheets("數(shù)據(jù)庫".SelectRange("A" & a + 1.SelectEnd Sub62：定位選定單元格式相同的所有單元格Sub

47、定位選定單元格式相同的所有單元格(Dim FirstCell As Range, FoundCell As RangeDim AllCells As RangeWith Application.FindFormat.Clear.NumberFormatLocal = Selection.NumberFormatLocal.HorizontalAlignment = Selection.HorizontalAlignment.VerticalAlignment = Selection.VerticalAlignment.WrapText = Selection.WrapText.Orientat

48、ion = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells.Locked = Selection.Locked.FormulaHidden = Selection.FormulaHiddenEnd With If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = Fir

49、stCellSet FoundCell = FirstCell DoIf FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCellsIf FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub63：按當(dāng)前單元文本定位Sub 按當(dāng)前單元文本定位(ABC = SelectionDim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like ABC ThenIf

50、 aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsEnd IfEnd IfNextaa.SelectEnd Sub64：按固定文本定位Sub 文本定位(Dim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like "*合計(jì)*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsEnd IfEnd IfNextaa.SelectEnd Sub65：刪

51、除包含固定文本單元的行或列Sub 刪除包含固定文本單元的行或列(DoCells.Find(what:="哈哈".ActivateLoop Until Cells.Find(what:="哈哈" Is NothingEnd Sub66：定位數(shù)據(jù)及區(qū)域以上的空值Sub 定位數(shù)據(jù)及區(qū)域以上的空值(Dim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like 0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsE

52、nd IfEnd IfNextaa.SelectEnd Sub67：右側(cè)單元自動(dòng)加5(工作表代碼Private Sub Worksheet_Change(ByVal Target As RangeApplication.EnableEvents = FalseTarget.Offset(0, 1 = Target + 5Application.EnableEvents = TrueEnd Sub68：當(dāng)前單元加2Sub 當(dāng)前單元加2(Selection = Selection + 2'Selection = Workbooks("臨時(shí)表".Sheets("

53、表2".Range("A1" 調(diào)用指定地址內(nèi)容End Sub69：A列等于A列減B列Sub A列等于A列減B列(For i = 1 To 23Cells(i, 1 = Cells(i, 1 - Cells(i, 2NextEnd Sub70：用于光標(biāo)選定多區(qū)域跳轉(zhuǎn)指定單元(工作表代碼Private Sub Worksheet_SelectionChange(ByVal T As Rangea = Array(b6:b7, e6, h6For i = 0 To 2If Not Application.Intersect(T, a(i Is Nothing Thena

54、1.Select: Exit ForEnd IfNextEnd Sub71：將A1單元錄入的數(shù)據(jù)累加到B1單元（工作表代碼）Private Sub Worksheet_Change(ByVal Target As RangeDim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1".ValueSheet1.Range("$B$1".Value = t + Target.ValueEnd IfEnd Sub72：在指定顏色區(qū)域選擇單元時(shí)添加/取消"&q

55、uot;（工作表代碼）Private Sub Worksheet_SelectionChange(ByVal Target As RangeDim myrg As RangeFor Each myrg In TargetNextEnd Sub73：在指定區(qū)域選擇單元時(shí)添加/取消""（工作表代碼）Private Sub Worksheet_SelectionChange(ByVal Target As RangeDim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, R

56、ange("D6:D20" Is Nothing ThenFor Each Rng In SelectionWith RngIf .Value = "" Then.Value = ""Else.Value = ""End IfEnd WithNextEnd IfEnd IfEnd Sub74：雙擊指定單元，循環(huán)錄入文本（工作表代碼）Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As BooleanIf T.Address <&

57、gt; "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"End Sub75：雙擊指定單元，循環(huán)錄入文本（工作表代碼）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As BooleanIf Target.Address = "$A$1&quo

58、t; Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1Target.Offset(1, 0.SelectEnd IfEnd Sub76：單元區(qū)域引用（工作表代碼）Private Sub Worksheet_Activate(Sheet1.Range("A1:B3".Value = Sheet2.Range("A1:B3".ValueEnd Sub77：在指定區(qū)域選擇單元時(shí)數(shù)值加1（工作表代碼）Private Sub Worksheet_SelectionChange(ByVal

59、Target As RangeIf Not Application.Intersect(a1:e10, Target Is Nothing ThenTarget = Val(Target + 1End IfEnd Sub259個(gè)常用宏-excelhome(32009-08-15 14:12:58 78：混合文本的編號Sub 混合文本的編號(Worksheets(1.Range("B2".Value = "北京" & (-(Mid(Worksheets(1.Range("B2", 3, 100 + 1End Sub79：指定區(qū)域

60、單元雙擊數(shù)據(jù)累加（工作表代碼）Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As BooleanIf Not Application.Intersect(A1:Y100, Target Is Nothing Thenoldvalue = Val(Target.Valueinputvalue = InputBox("請輸入數(shù)量,按ENTER鍵確認(rèn)!", "數(shù)值累加器"Target.Value = oldvalue + inputvalueEnd IfEnd Sub

61、80：選擇單元區(qū)域觸發(fā)事件（工作表代碼）Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Target.Address = "$A$1:$B$2" ThenMsgBox "你選擇了$A$1:$B$2單元"End IfEnd Sub81：當(dāng)修改指定單元內(nèi)容時(shí)自動(dòng)執(zhí)行宏（工作表代碼）Private Sub Worksheet_Change(ByVal Target As RangeIf Not Application.Intersect(Target, B3:B4 Is Nothing Then重排窗口End IfEnd Sub82：被指定單元內(nèi)容限制執(zhí)行宏Sub 被指定單元限制執(zhí)行宏(If Range("$A$1" = "關(guān)閉" Then Exit Sub窗口End Sub83：雙擊單元隱藏該行（工作表代