基礎(chǔ)代碼集打開全部隱藏工作表

1、登錄打開全部隱藏工作表# 工作表# 宏管理# 其他# 篩選# 宏管理# 宏管理# 宏管理# 宏管理# 宏管理# 宏管理# 宏管理# 控件# 控件# 控件# 打印# 打印# 打印# 對象# 查找和# 查找和# 查找和# 查找和# 查找和# 查找和# 對象# 批注# 批注# 批注# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 工作表# 工作表# 工作表奇偶頁分別打印自動打印多工作表第一頁查找A列文本循環(huán)分頁符將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小返回光標(biāo)所在行數(shù)在A1返回當(dāng)前選中單

2、元格數(shù)量返回當(dāng)前工作簿中工作表數(shù)量 返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)工作表中包含數(shù)據(jù)的最大行數(shù)返回A列數(shù)據(jù)的最大行數(shù)將所選區(qū)域文本新建文本框批量批量地址批注統(tǒng)一批注以A1單元內(nèi)容批量批注不連續(xù)區(qū)域當(dāng)前文件名和表名及地址不連續(xù)區(qū)域錄入當(dāng)前單元地址連續(xù)區(qū)域錄入當(dāng)前單元地址 返回當(dāng)前單元地址不連續(xù)區(qū)域錄入當(dāng)前日期不連續(xù)區(qū)域錄入當(dāng)前數(shù)字日期 不連續(xù)區(qū)域錄入當(dāng)前日期和時間不連續(xù)區(qū)域錄入對勾不連續(xù)區(qū)域錄入當(dāng)前文件名不連續(xù)區(qū)域添加文本不連續(xù)區(qū)域文本從指置向下同時錄入多單元指定內(nèi)容按aa工作表A列的內(nèi)容排列工作表順序以A1單元文本作表名工作表刪除全部未選定工作表循環(huán)宏錄制宏時調(diào)用“停止錄制” 工具欄高級篩選5列不

3、重復(fù)數(shù)據(jù)至指定表雙擊單元執(zhí)行宏( 工作表代碼)雙擊指定區(qū)域單元執(zhí)行宏( 工作表代碼)進(jìn)入單元執(zhí)行宏( 工作表代碼)進(jìn)入指定區(qū)域單元執(zhí)行宏( 工作表代碼)在多個宏中依次循環(huán)執(zhí)行一個（控件按鈕代碼）在兩個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）在三個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）根據(jù)A1單元文本隱藏/顯示按鈕（控件按鈕代碼）當(dāng)前單元返回按鈕名稱（控件按鈕代碼）當(dāng)前單元內(nèi)容返回到按鈕名稱（控件按鈕代碼）代碼目錄類別工作表排序# 工作表# 工作表# 文件管理# 工作表# 工作表# 單元賦值# 單元賦值# 工作表# 單元賦值# 單元賦值# 格式# 批注# 單元賦值#

4、 # # # # 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# 單元賦值# # # 其他# 其他# 打印# 單元賦值# 對象# 其他# 信息定義指定工作表顏色在目錄表建立本工作簿中各表目錄建立工作表文本目錄查另一文件的全部表名當(dāng)前單元錄入計算機(jī)名當(dāng)前單元錄入計算機(jī)用戶名解除全部工作表保護(hù)為指定工作表加指定保護(hù)表在有的工作表執(zhí)行代碼執(zhí)行前需要驗證的宏(控件按鈕代碼)數(shù)值條件格式透明批注添加文本右側(cè)單元自動加5( 工作表代碼) 當(dāng)前單元加2A列等于A列減B列將A1單元錄入的數(shù)據(jù)累加到B1單元（工作表代碼）在指定顏域選擇單元時

5、添加/取消""（工作表代在指定區(qū)域選擇單元時添加/取消""（工作表代碼）雙擊指定單元，循環(huán)錄入文本（工作表代碼） 單元區(qū)域（工作表代碼）在指定區(qū)域選擇單元時數(shù)值加1（工作表代碼）混合文本的編號指定區(qū)域單元雙擊數(shù)據(jù)累作表代碼）選擇單元區(qū)域觸發(fā)（工作表代碼）當(dāng)修改指定單元內(nèi)容時自動執(zhí)行宏（工作表代碼）被指定單元內(nèi)容限制執(zhí)行宏雙擊單元隱藏該行（工作表代碼）高亮顯示行（工作表代碼）高亮顯示行和列（工作表代碼）為指定工作表設(shè)置滾動范圍（工作簿代碼）在指定單元打印和預(yù)覽次數(shù)（工作簿代碼）自動數(shù)字金額轉(zhuǎn)大寫（工作表代碼）將全部工作表的A1單元作為單擊按鈕（工作簿代碼）

6、鬧鐘到指定時間執(zhí)行宏（工作簿代碼）改變Excel界面標(biāo)題的宏（工作簿代碼）在指定工作表的指定單元返回光標(biāo)當(dāng)前多選區(qū)地址（工作簿代碼）用于光標(biāo)選定多區(qū)域跳轉(zhuǎn)指定單元( 工作表代碼)光標(biāo)到指定工作表A列最后數(shù)據(jù)行下一單元選定單元格式相同的全部單元格按當(dāng)前單元文本按固定文本刪除包含固定文本單元的行或列數(shù)據(jù)及區(qū)域以上的空值拷貝A1公式和格式到A2單元數(shù)值# 單元賦值# 單元賦值# 編輯# 編輯# 行列操作# 行列操作# 行列操作# 行列操作# # # 名稱# 名稱# 單元賦值# 名稱# 格式# 對象# 數(shù)據(jù)# 單元賦值# 名稱# 名稱# 工作表# 工作表# 工作表# 其他# 其他# 文件管理# 文件管

7、理# 文件管理# 文件管理# 文件管理# 文件管理# 文件管理# 文件管理# 文件管理# 文件管理# 文件管理# 單元賦值# 單元賦值# 行列操作）每編輯一個單元保存文件指定解除編輯區(qū)域編輯區(qū)域限制刪除指定行刪除A列為指定內(nèi)容的行刪除A列非數(shù)字單元行 有條件刪除當(dāng)前行選擇下一行選擇第5行開始所有數(shù)據(jù)行選擇光標(biāo)或選區(qū)所在行選擇光標(biāo)或選區(qū)所在列光標(biāo)到名稱指置選擇名稱定義的數(shù)據(jù)區(qū)選擇到指定列的最后行將Sheet1的A列的非空值寫到Sheet2的A列將名稱1的數(shù)據(jù)寫到名稱2單元反選調(diào)整選中對象中的文字去除指定范圍內(nèi)的對象更新表數(shù)據(jù)項將全部工作表名稱寫到A列以指定區(qū)域為表目錄補(bǔ)充新表按A列數(shù)據(jù)批量修改表

8、名稱按A列數(shù)據(jù)批量創(chuàng)建新表( 控件按鈕代碼)清除剪貼板批量清除軟回車指定文件是否已經(jīng)打開當(dāng)前文件另存到指定目錄 另存指定文件名指置單元內(nèi)容為部分文件名另存文件將A列數(shù)據(jù)排序到D列將指定范圍的數(shù)據(jù)排列到D列光標(biāo)移動光標(biāo)所在行上移一行以本工作表名稱另存文件到當(dāng)前目錄將本工作表單獨另存文件到Excel當(dāng)前默認(rèn)目錄以活動工作表名稱另存文件到Excel當(dāng)前默認(rèn)目錄另存所有工作表為工作簿以指定單元內(nèi)容為新文件名另存文件以當(dāng)前日期為新文件名另存文件以當(dāng)前日期和時間為新文件名另存文件另存本表為TXT文件為當(dāng)前選定的多單元指定名稱刪除全部名稱B列錄入數(shù)據(jù)時在A列返回時間（工作表代碼當(dāng)指定區(qū)域修改時在其右側(cè)的2個

9、單元返回當(dāng)前日期和時間（工作表代碼）指定單元顯示光標(biāo)位置內(nèi)容（工作表代碼）加數(shù)據(jù)有效限制 取消數(shù)據(jù)有效限制重排窗口按當(dāng)前單元文本選擇打開指定文件單元回車光標(biāo)向右回車光標(biāo)向下保護(hù)工作表時取消選定鎖定單元# 數(shù)據(jù)# 數(shù)據(jù)# 窗口# # 工作表# 文件管理# 行列操作# 工作表# 工作表# 工作表# 工作表# 工作表# 格式# 工作表# 工作表# 工作表# 工作表# 行列操作# 格式# 格式# 數(shù)據(jù)# 其他# 其他# 單元賦值# # # 單元賦值# 篩選# 篩選# 篩選# 篩選# 格式# 格式# 單元賦值# 行列操作# 單元賦值保存并Excel關(guān)閉文件時自動隱藏指定工作表(ThisWorkbook)

10、打開文件時提示指定工作表是保護(hù)狀態(tài)(ThisWorkbook全選選定范圍內(nèi)小于0的單元固定區(qū)域單元分類變色 A列半角內(nèi)容變紅在F1單元顯示光標(biāo)位置批注內(nèi)容的代碼顯示光標(biāo)所在單元的批注的代碼使單元內(nèi)容保持不變的工作表代碼拷貝指定表不相鄰多列數(shù)據(jù)到新位置選擇2至4行在當(dāng)前選區(qū)有條件替換數(shù)值為文本自動篩選全部顯示指定列自動篩選第2列值為A的行取消自動篩選()全部顯示指定表的自動篩選強(qiáng)行合并單元設(shè)置單元區(qū)域格式 在所有工作表的A1單元返回順序號刪除A列空行在A列產(chǎn)生不重復(fù)隨機(jī)數(shù)根據(jù)A1單元內(nèi)容返回C1數(shù)值根據(jù)A1內(nèi)容選擇執(zhí)行宏有條件執(zhí)行宏有條件執(zhí)行不同的宏提示確定或取消執(zhí)行宏提示開始和結(jié)束單元格錄入數(shù)

11、據(jù)時運行宏的代碼焦點到A列時運行宏的代碼根據(jù)B列最后數(shù)據(jù)快速合并A列單元格的控件代碼10行全選固定范圍內(nèi)小于0的單元隱藏/顯示指定列空值行深度隱藏指定工作表隱藏指定工作表隱藏當(dāng)前工作表返回當(dāng)前工作表名稱獲取上一次所進(jìn)入工作簿的工作表名稱按光標(biāo)選定顏色隱藏本列其他顏色行打開工作簿自動隱藏錄入表以外的其他表除最左邊工作表外深度隱藏所有表將A列數(shù)據(jù)隨機(jī)排列到F列取消選定區(qū)域的公式只保留值( 假空轉(zhuǎn)真空)# 單元賦值# 單元賦值# 其他# 信息# 格式# 格式# 單元賦值# 工作表# 工作表# 單元賦值# 自定義函數(shù)# 信息# 超# 超# 超# 超# 查找和# 查找和# 查找和# 查找和# 查找和#

12、查找和# 查找和# 查找和# 查找和# 查找和# 其他# 打印# 單元賦值# 單元賦值# 單元賦值# 打印# # 信息# 工作表# 工作表# 窗口# 單元賦值# 打印# 文件管理# 文件管理# 單元賦值# 語音# 語音# 對象處理導(dǎo)入的顯示為科學(xué)計數(shù)法樣式的返回指定單元的行高和列寬指定行高和列寬指定單元的行高和列寬與A1單元相同填公式建立當(dāng)前工作表的副本為001表號在第一個表前多工作表清除A列再序號返回表中第一個非空單元地址(行搜索) 返回表中各非空單元區(qū)域地址(行搜索) 返回第一個數(shù)值行號返回非空單元數(shù)量返回A列非空單元數(shù)量返回圓周率定義指定單元內(nèi)容為頁眉/頁腳提示并全部清除當(dāng)前選擇區(qū)域全部

13、清除當(dāng)前選擇區(qū)域清除指定區(qū)域數(shù)值對指定工作表執(zhí)行取消隱藏打印隱藏工作表打開文件時執(zhí)行指定宏(工作簿代碼)關(guān)閉文件時執(zhí)行指定宏(工作簿代碼) 彈出提示A1單元內(nèi)容延時15秒執(zhí)行重排窗口宏撤消工作表保護(hù)并取消重算指定表將第5行移到窗口的最上面對第一張工作表的指定區(qū)域進(jìn)行排序顯示指定工作表的打印預(yù)覽用單元格A1的內(nèi)容作為文件名另存當(dāng)前工作簿禁用/啟用保存和另存的代碼在A和B列返回當(dāng)前選區(qū)的名稱和公式朗讀朗讀A列,按ESC鍵中止朗讀固定語句，請按ESC鍵終止在M和N列的14行以下選擇單元時顯示調(diào)用日歷控件（ 工作表代碼）返回第1行最右邊非空單元的列號返回連續(xù)數(shù)值單元的數(shù)量統(tǒng)計指定范圍和內(nèi)容的單元數(shù)量統(tǒng)

14、計不同顏色的數(shù)字的和（自定義函數(shù)）反方向文本(自定義函數(shù))指定選擇單元區(qū)域彈出消息將B列數(shù)據(jù)添加超到K列刪除B列數(shù)據(jù)的超分離臨時表A列數(shù)據(jù)的文本和超并整理到數(shù)據(jù)庫表分離臨時表A列數(shù)據(jù)的文本和超并會同其他數(shù)據(jù)整理到數(shù)據(jù)庫表返回A列最后一個非空單元行號添加自定義序列彈出打印 框返回總頁碼# 其他# 打印# 打印# 工作表# 查找和# 查找和# 工作表# 其他# 其他# 圖片# 工作表# 工作表# 其他# 其他# 工作表# 工作簿# 工作表# 工作簿# 工作簿# 批注# 其他# 其他隱藏指定工作表的指定列把a(bǔ)列不重復(fù)值取到e列 當(dāng)前選區(qū)的行列數(shù)單元格錄入1位字符就跳轉(zhuǎn)(工作表代碼) 當(dāng)指定日期（每月

15、10日）打開文件執(zhí)行宏提示并清空單元區(qū)域返回光標(biāo)所在行號VBA返回公式結(jié)果按照當(dāng)前行A列的圖片名稱到H列當(dāng)前行下1行取消指定行或列的隱藏單元格所在行單元格所在列新建一個工作表 新建一個工作簿 選擇多表為工作組刪除指定文件合并A1至C1的內(nèi)容寫到D15單元的批注中自動重算手動重算在當(dāng)前工作組各表中分別執(zhí)行指定宏當(dāng)前工作簿的報表到臨時工作簿合并各工作表內(nèi)容合并指定目錄中所有文件中相同格式工作表的數(shù)據(jù)宏文件集打開全部隱藏工作表#Sub Dim For打開全部隱藏工作表()i As Integeri = 1 To Sheets.Count Sheets(i).Visible = TrueNext iE

16、ndSubSubAAA循環(huán)()=Range("C2")Dim Dimi As Long times As Longtimes = AAA'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可(不可小于1，不可大于2147483647) For i = 1 To timesCall 過濾一行If Range("完成標(biāo)志") = "完成" Then Exit For'如果名為'完成標(biāo)志''If Sheets("傳送參數(shù)").Range("A" & i).

17、Text = "完成" Then Exit Next iEnd SubFor'如果某列出現(xiàn)"完成"內(nèi)容則循環(huán)Sub 錄制宏時調(diào)用停止錄制工具欄() Application.CommandBars("Stop Recording").Visible = True End SubSub 高級篩選5列不重復(fù)數(shù)據(jù)至Sheet2()Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列13/159高級篩選5列不重復(fù)

18、數(shù)據(jù)至指定表#錄制宏時調(diào)用“停止錄制” 工具欄#循環(huán)宏#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, Orie

19、ntation:=xlTopToBottom,:=xlPinYinSortMethod _End SubPrivate Sub Worksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)If Range("$A$1") = "關(guān)閉" Then Select Case Target.AddressCase "$A$4" Call 宏1 Cancel = TrueCase "$B$4" Call 宏2 Cancel = TrueCase "$

20、C$4" Call 宏3 Cancel = TrueCase "$E$4"Call 宏4 Cancel = TrueEnd SelectEnd SubExitSubPrivate Sub Worksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)If Range("$A$1") = "關(guān)閉" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9",End Sub&qu

21、ot;C4:C9")Is Nothing Then Call打開隱藏表Private Sub Worksheet_SelectionChange(ByVal Target As Range)14/159進(jìn)入單元執(zhí)行宏( 工作表代碼)#雙擊指定區(qū)域單元執(zhí)行宏( 工作表代碼)#雙擊單元執(zhí)行宏( 工作表代碼)#'以單元格進(jìn)入代替按鈕對象調(diào)用宏If Range("$A$1") = "關(guān)閉" Then Exit Sub Select Case Target.AddressCase "$A$5" '單元地址(Target

22、.Address),或命Call 宏1Case "$B$5" Call 宏2 Case "$C$5" Call 宏3End SelectEnd Sub元名字(Target.Name)Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("$A$1") = "關(guān)閉" Then Exit SubIf Not Application.Intersect(Target, End SubRange("A4:A9",&qu

23、ot;C4:C9")IsNothingThenCall打開隱藏表Private Sub CommandButton1_Click() Static RunMacro As IntegerSelect Case RunMacro Case 0宏1RunMacro = 1Case 1 宏2RunMacro = 2Case 2 宏3RunMacro = 0 End Select End Sub15/159在多個宏中依次循環(huán)執(zhí)行一個（控件按鈕代碼）#進(jìn)入指定區(qū)域單元執(zhí)行宏( 工作表代碼)#Private Sub CommandButton1_Click() With CommandButto

24、n1If .Caption = "保護(hù)工作表" Then Call 保護(hù)工作表.Caption = "取消工作表保護(hù)" Exit SubEnd IfIf .Caption = "取消工作表保護(hù)" Then Call 取消工作表保護(hù).Caption = "保護(hù)工作表" Exit SubEnd If End With End SubOption ExplicitPrivate Sub CommandButton1_Click() With CommandButton1If.Caption = "宏1"

25、; Then Call 宏1.Caption = "宏2" Exit SubEnd IfIf.Caption = "宏2" Then Call 宏2.Caption = "宏3" Exit SubEnd IfIf.Caption = "宏3" Then Call 宏3.Caption = "宏1" Exit Sub16/159在三個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）#在兩個宏中依次循環(huán)執(zhí)行一個并相應(yīng)修改按鈕名稱（控件按鈕代碼）#End If End With End SubP

26、rivate Sub Worksheet_SelectionChange(ByVal If Range("A1") > 2 Then CommandButton1.Visible = 1Else CommandButton1.Visible = 0 End IfEnd SubPrivate Sub CommandButton1_Click() 重排窗口End SubTargetAsRange)Private Sub CommandButton1_Click() ActiveCell = CommandButton1.Caption End SubPrivate Sub

27、 CommandButton1_Click() CommandButton1.Caption = ActiveCell End SubSub 奇偶頁分別打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)")MsgBox "現(xiàn)在打印奇數(shù)頁,按確定開始."For i = 1 To Ps Step 2'總頁數(shù)17/159奇偶頁分別打印#當(dāng)前單元內(nèi)容返回到按鈕名稱（控件按鈕代碼）#當(dāng)前單元返回按鈕名稱（控件按鈕代碼）#根據(jù)A1單元文本隱藏/顯示按鈕（控件按鈕代碼）#ActiveSheet.Pr

28、intOut from:=i, To:=i Next iMsgBox "現(xiàn)在打印偶數(shù)頁,按確定開始."For i = 2 To Ps Step 2 ActiveSheet.PrintOut from:=i, To:=iNext iEndSubSub Dim Dim Dim Dim Dim x =自動打印多工作表第一頁()sh As Integerx y sysyzInputBox("請輸入起始工作表名字:")sy = InputBox("請輸入結(jié)束工作表名字:")y = syzSheets(x).Index= Sheets(sy).I

29、ndexFor sh = y To syz Sheets(sh).Select Sheets(sh).PrintOut from:=1, To:=1 Next shEnd Sub查找A列文本循環(huán)分頁符Sub 循環(huán)分頁符()' Selection = Workbooks("臨時表").Sheets("表2").Range("A1") 調(diào)用指定地址內(nèi)容Dim i As LongDim times As Longtimes = Application.WorksheetFunction.CountIf( Sheet1.Range(&

30、quot;a:a"), "分頁")'times代表循環(huán)次數(shù)，執(zhí)行前把times賦值即可( 不可小于1，不可大于2147483647 ) For i = 1 To times18/159#自動打印多工作表第一頁#CallNext iEnd Sub分頁符Sub分頁符()Cells.Find( What:="分頁", After:=ActiveCell, LookIn:=xl Values, Look At:= _xl Part, Search Order:=xl ByRows, Search Direction:=xl Next, Matc

31、h Case:=False). ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell End Sub_Sub取消原分頁() Cells.Select ActiveSheet.Res SublPageBreaksEndSub將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小()Dim i = ForPic As Picture, i& A65536.End(xlUp).Row Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.

32、TopLeftCell, Pic.Top = Pic.TopLeftCell.TopPic.Left = Pic.TopLeftCell.Left Pic.Height = Pic.TopLeftCell.Height Pic.Width = Pic.TopLeftCell.WidthEnd IfRange("B1:B"&i)IsNothingThenNext SubEndSubx =返回光標(biāo)所在行數(shù)() ActiveCell.RowRange("A1") = x19/159返回光標(biāo)所在行數(shù)#將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大

33、小#End SubSub 在A1返回當(dāng)前選中單元格數(shù)量()A1 = Selection.CountEndSubSub t =返回當(dāng)前工作簿中工作表數(shù)量() Application.Sheets.CountMsgBox tEndSubSubx =y =返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)() Selection.Rows.Count Selection.Columns.CountRange("A1") = xRange("A2") = yEndSubSub n =包含數(shù)據(jù)的最大行數(shù)()Cells.Find("*", , , , 1,2).Row

34、MsgBox nEndSubSub n =返回A列數(shù)據(jù)的最大行數(shù)()Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub20/159將所選區(qū)域文本新建文本框#返回A列數(shù)據(jù)的最大行數(shù)#工作表中包含數(shù)據(jù)的最大行數(shù)#返回光標(biāo)選擇區(qū)域的行數(shù)和列數(shù)#返回當(dāng)前工作簿中工作表數(shù)量#在A1返回當(dāng)前選中單元格數(shù)量#Sub For n = Next將所選區(qū)域文本新建文本框()Each rag In Selectionn & rag.Value & Chr(10)ActiveSheet.Shapes.AddTe

35、xtbox(msoTextOrientationHorizontal, Selection.Characters.Text = "問題：" & nActiveCell.Left+ActiveCell.Width,ActiveCell.TWith Selection.Characters(Start:=1,.Name = "黑體".FontStyle = "常規(guī)".Size = 12 End WithSubLength:=3).FontEndSub批量地址批注() Resume Next RangeOn Error Dim r

36、AsIf Selection.Cells.Count > 0 Then For Each r In Selection r.Comment.Deleter.AddComment r.Comment.Visible = Falser.Comment.Text Text:="本單元格：" & r.Address & " of " & NextSelection.AddressEnd EndIf SubSub Dim msg批量統(tǒng)一批注()r As Range, msg As String= InputBox("請輸入欲

37、批量的批注", "提示", "隨便輸點什么吧")If Selection.Cells.Count > 0 Then For Each r In Selection r.AddComment21/159批量統(tǒng)一批注#批量地址批注#r.Comment.Visible = False r.Comment.Text Text:=msg NextEnd EndIf SubSub Dim以A1單元內(nèi)容批量r As Range批注()If Selection.Cells.Count > 0 Then For Each r In Selection

38、 r.AddCommentr.Comment.Visible = False r.Comment.Text Text:=a1.Text NextEnd IfEnd Sub不連續(xù)區(qū)域當(dāng)前文件名和表名及地址Sub 批量當(dāng)前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "" + ActiveWorkbook.Name + "" + ActiveSheet.Name + "!"NextEnd Sub+ mycell.Address不連續(xù)區(qū)域錄入當(dāng)前單元地址 #Sub 區(qū)

39、域錄入當(dāng)前單元地址()For Each mycell In Selection mycell.FormulaR1C1 = mycell.AddressNextEnd Sub連續(xù)區(qū)域錄入當(dāng)前單元地址 #Sub 連續(xù)區(qū)域錄入當(dāng)前單元地址()22/159#以A1單元內(nèi)容批量批注#Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteValues,:=False, Transpose:=FalseSubOperation:=xlNone,SkipBla

40、nks_EndSub d =返回當(dāng)前單元地址() ActiveCell.AddressA1 = dEnd SubSub 區(qū)域錄入當(dāng)前日期() Selection.FormulaR1C1 End Sub= Format(Now(),"yyyy-m-d")Sub 區(qū)域錄入當(dāng)前數(shù)字日期()Selection.FormulaR1C1 = Format(Now(),End Sub"yyyymmdd")不連續(xù)區(qū)域錄入當(dāng)前日期和時間Sub 區(qū)域錄入當(dāng)前日期和時間()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d

41、 h:mm:ss") End Sub不連續(xù)區(qū)域錄入對勾 #Sub 批量錄入對勾() Selection.FormulaR1C1 = "" End Sub不連續(xù)區(qū)域錄入當(dāng)前文件名 #Sub 批量錄入當(dāng)前文件名()23/159#不連續(xù)區(qū)域錄入當(dāng)前數(shù)字日期#不連續(xù)區(qū)域錄入當(dāng)前日期#返回當(dāng)前單元地址#Selection.FormulaR1C1 = ThisWorkbook.NameEndSubSub Dim For s = Next批量添加文本()s As RangeEach s In Selection s & "文本內(nèi)容"End Sub不連

42、續(xù)區(qū)域文本Sub Dim For s = Next批量文本()Ranges In Selections As Each"文本內(nèi)容" & sEnd Sub從指置向下同時錄入多單元指定內(nèi)容Sub Dim arr從指arr置向下同時錄入多單元指定內(nèi)容()= Array("1", "2", "13", "25", "46", "12", "0", "20")B2.Resize(8, 1) = Application.

43、WorksheetFunction.Transpose(arr) End SubSub 按aa工作表A列的內(nèi)容排列工作表順序()Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).Value <> ""str1 = Trim(Cells(I, 1).Value)24/159按aa工作表A列的內(nèi)容排列工作表順序#不連續(xù)區(qū)域添加文本#Sheets(str1).Select Sheets(str1).Move after:=Sheets(I) I = I + 1Sheets("

44、;aa").SelectLoopEnd Sub以A1單元文本作表名工作表Sub 以A1單元文本作表名Dim nm As String nm = a1 Sheets.Add ActiveSheet.Name =End Sub工作表()nm 刪除全部未選定工作表 #Sub刪除全部未選定工作表()Dim Dim n =sht As Worksheet, n As Integer, iFlag As ShtName() As String ActiveWindow.SelectedSheets.CountBooleanReDim ShtName(1 To n) n = 1For Each s

45、ht In ActiveWindow.SelectedSheets ShtName(n) = sht.Namen = n + 1NextApplication.DisplayAlerts = False For Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = sht.Name Then iFlag = TrueExit For25/159#End IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = True SubEndSub Dim

46、工作表排序()i As Long, j As Long, nums As Long, msg As Longmsg= MsgBox("工作表按升序排列請選 '是Y'. " & vbCrLf & vbCrLf & "工作表按降序排列請選'否N'",vbYesNoCancel,If msg= vbCancel Then Exit Subnums =Sheets.CountIfmsg = vbYes Then 'Sort ascending For i = 1 To numsFor j = i T

47、o numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Sheets(j).Move Before:=Sheets(i)End If Next jNext iThenElse 'Sort descending For i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) Sheets(j).Move Before:=Sheets(i)End If Next jNext iEnd IfThen26/159工作表排序#En

48、d Sub定義指定工作表顏色Sub 定義指定工作表顏色()Sheets("Sheet1").Tab.ColorIndex = 46EndSubSub Dim在目錄表建立本工作簿中各表s%, Rng As RangeOn Error Resume Next Sheets("目錄").Activate If Err = 0 Then目錄()Sheets("目錄").UsedRange.Delete ElseSheets.AddActiveSheet.Name = "目錄" End IfFor i = 1 To Shee

49、ts.CountIf Sheets(i).Name <> "目錄" Thens = Set Rngs + 1Rng = Sheets("目錄").Cells(s- 1) Mod 20) + 1, (s - 1) 20 + 1 + 1)= Format(s, " 0") & ". " & Sheets(i).NameActiveSheet.Hyperlinks.Add Rng, "#" & Sheets(i).Name & "!A1"

50、, ScreenTip:=Sheets(i).Name End IfNextSheets("目錄").Range("b:iv").EntireColumn.ColumnWidth = 20 SubEnd建立工作表文本目錄 #Sub 建立工作表文本目錄()Sheets.Add before:=Sheets(1)27/159在目錄表建立本工作簿中各表目錄#Sheets(1).Name = "目錄"For i = 2 To Sheets.Count Cells(i - 1, 1) = Sheets(i).Name'Sheets(1)

51、.Hyperlinks.Add Cells(i- 1, 1), "#" & Sheets(i).Name&"!A1"'添加超NextEnd SubSub 查另一文件的全部表名()On Error Resume Next Dim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=ThisWorkbook.Path & "2.xls"Windows("1.xls").Activa

52、te '當(dāng)前文件名稱Sheets("Sheet1").Select'當(dāng)前表名稱i = 1 For Each Cells(i,'將表名稱返回到第1行sh In Workbooks("2.xls").Worksheets1) = sh.Name'將表名稱返回到第1列 '返回每個表名稱向下移動1行i = i + 1Next shWindows("2.xls").Close'關(guān)閉對象文件Application.Screen Updating = True End SubSub 當(dāng)前單元錄入計算機(jī)

53、名()Selection = Environ("COMPUTERNAME")'Selection = Workbooks("臨時表").Sheets("表2").Range("A1") End Sub調(diào)用指定地址內(nèi)容28/159當(dāng)前單元錄入計算機(jī)名#查另一文件的全部表名#Sub 當(dāng)前單元錄入計算機(jī)用戶名()Selection = Environ("Username")'Selection = Workbooks("臨時表").Sheets("表2&q

54、uot;).Range("A1") 調(diào)用指定地址內(nèi)容End SubSub Dim解除全部工作表保護(hù)()n As IntegerFor n = 1 To Sheets.Count Sheets(n).UnprotectNext n SubEnd為指定工作表加指定保護(hù)表Sub 為指定工作表加指定保護(hù)表()Sheet10.Protect Password:="123" End Sub在有的工作表執(zhí)行代碼Sub 在有的工作表執(zhí)行代碼()Sheets("1").Unprotect Password:=123 '假定表名為“1”，為“12

55、3”打開工作表'隱藏C列空值行Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden=TrueSheets("1").Protect Password:=123End Sub'重新用保護(hù)工作表Private Sub CommandButton 1_Click()If InputBox("請輸入：") <> "123" Then!", 64, "提示"'是123MsgBox " Exit Sub End If錯誤,按確定Cells( 1, 1) = 10 End Sub29/159執(zhí)行前需要驗證的宏( 控件按鈕代碼)#解除全部工作表保護(hù)#當(dāng)前單元錄入計算機(jī)用戶名#Sub 執(zhí)行前需要驗證的宏()If InputBox("請輸入您的使用權(quán)限:", "系統(tǒng)提示") = 123Then重排窗口Else'要執(zhí)行的宏代碼或宏名稱MsgBox "對不起,您沒有使用該宏的權(quán)限,按確定鍵后End IfEnd Sub!"Sub 拷貝A1公式到A2()Workbooks("臨時表").Sheets(