【正文】 s Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 2) = Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 3) = Range(Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 3), Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 3)). Anchor:=Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 3), Address:=Worksheets(數(shù)據(jù)庫).Cells(ier + 1, 3) ier = ier + 1 NextEnd Sub 201：返回A列最后一個非空單元行號Sub 返回A列最后非空單元行號() MsgBox (A65536).End(xlUp).RowEnd Sub 202：返回表中第一個非空單元地址(行搜索)Sub 返回表中第一個非空單元地址() MsgBox (*).AddressEnd Sub 203：返回表中各非空單元區(qū)域地址(行搜索)Sub 返回表中各非空單元區(qū)域地址() MsgBox (2).AddressEnd Sub 204：返回第一個數(shù)值行號Sub 返回第一個數(shù)值行號() MsgBox [b:b].SpecialCells(2, 1).RowEnd Sub 205：返回第1行最右邊非空單元的列號Sub 返回第1行最右邊非空單元的列號() X = [IV1].End(xlToLeft).Column MsgBox XEnd Sub 206：返回連續(xù)數(shù)值單元的數(shù)量Sub 返回連續(xù)數(shù)值單元的數(shù)量() MsgBox [b:b].SpecialCells(2, 1).End Sub 207：統(tǒng)計指定范圍和內容的單元數(shù)量Sub 統(tǒng)計指定范圍和內容的單元數(shù)量() x = (Range(A3:B100), 總計) Range(B1) = xEnd Sub 208：統(tǒng)計不同顏色的數(shù)字的和（自定義函數(shù)）Public Function COLOR(ByVal X As Range, Y)For Each I In X If = Y Then COLOR = COLOR + I End IfNext IEnd Function39。統(tǒng)計紅色,輸入：=COLOR(B2:B8,3)39。統(tǒng)計藍色,輸入：=COLOR(B2:B8,5) 209：返回非空單元數(shù)量Sub 返回非空單元數(shù)量() x = (Range(A1:Z65536)) MsgBox xEnd Sub 210：返回A列非空單元數(shù)量Sub 返回A列非空單元數(shù)量() y = (Columns(1)) MsgBox yEnd Sub 211：返回圓周率πSub Macro1() Range(A1) = ()End Sub 212：定義指定單元內容為頁眉/頁腳Sub 定義指定單元內容為頁眉/頁腳() BBB = Sheets(表1).Range(A2) With .CenterHeader = BBB 39。定義頁眉39。 .CenterFooter = BBB 39。定義頁腳 End WithEnd Sub 213：提示并所有清除當前選擇區(qū)域Sub 提示并所有清除當前選擇區(qū)域() If MsgBox(你確定要清除選擇的區(qū)域嗎?, vbYesNo, 提示:) = vbYes Then End Sub 214：所有清除當前選擇區(qū)域Sub 所有清除當前選擇區(qū)域() 39。 Range(A1:B10).Clear 39。所有清除指定區(qū)域End Sub 215：清除指定區(qū)域數(shù)值Sub 清除單元數(shù)值() Sheet1.[A1:A10].ClearContentsEnd SubSub 清除指定區(qū)域數(shù)值() Range(A1:C8) = ClearContentsEnd SubSub 清除指定區(qū)域數(shù)值() Sheet1.[A1:A10]=End Sub 216：對指定工作表執(zhí)行取消隱藏》打印》隱藏工作表Sub 打印隱藏工作表()Sheets(報表1).Visible = 1Sheets(報表1).PrintOut Copies:=1, Collate:=TrueSheets(報表1).Visible = 0End Sub 217：打開文件時執(zhí)行指定宏(工作簿代碼)Private Sub Workbook_Open() 重排窗口 39。要執(zhí)行的宏名稱End Sub 218：關閉文件時執(zhí)行指定宏(工作簿代碼)Private Sub Workbook_BeforeClose(Cancel As Boolean)重排窗口 39。要執(zhí)行的宏名稱End Sub 219：彈出提示A1單元內容Sub 彈出提示A1單元內容()MsgBox 提示 amp。 Range(A1).ValueEnd Sub 220：延時15秒執(zhí)行重排窗口宏Sub 延時15秒重排窗口() Now + TimeValue(00:00:15), 重排窗口End Sub 221：撤消工作表保護并取消密碼Sub 撤消工作表保護并取消密碼() Password:=123456End Sub 222：重算指定表Sub 重算指定表()Worksheets(傳送參數(shù)).CalculateWorksheets(目錄).CalculateEnd Sub 223：將第5行移到窗口的最上面Worksheets(Sheet1).Activate = 5 224：對第一張工作表的指定區(qū)域進行排序Sub 對第一張工作表的指定區(qū)域進行排序() With Worksheets(1) .Range(a2:a100).Sort Key1:=.Range(a1) End WithEnd Sub 225：顯示指定工作表的打印預覽Sub 顯示指定工作表的打印預覽()Worksheets(Sheet1).PrintPreviewEnd Sub 226：用單元格A1的內容作為文件名另存當前工作簿Sub b() Range(A1) + .xlsEnd Sub 227：[禁用/啟用]保存和另存的代碼Sub 禁用保存()(File).Controls(4).Enabled = False(File).Controls(5).Enabled = FalseEnd SubSub 啟用保存()(File).Controls(4).Enabled = True(File).Controls(5).Enabled = TrueEnd Sub 228：在A和B列返回當前選區(qū)的名稱和公式Sub 在A和B列返回當前選區(qū)的名稱和公式()[a1].ListNamesEnd Sub 229：朗讀朗讀A列,按ESC鍵中止Sub 朗讀A列() Dim myStr$, iamp。, tRng As Range Dim mySpk As Speech i = [A65536].End(xlUp).Row Set mySpk = myStr = Replace(Replace(Range(A1:A amp。 i).Address, $, ), :, 到) On Error Resume Next With mySpk .Speak _, , , False For Each tRng In Range(A1:A amp。 i) If 0 Then .Speak _, , , True: Exit Sub If Not tRng Is Nothing Then .Speak tRng, , , False Next End WithEnd Sub 230：朗讀固定語句，請按ESC鍵終止Sub 朗讀固定語句() On Error Resume Next 你好，節(jié)日快樂。, , , False If 0 Then , , , True End IfEnd Sub 231：在M和N列的14行以下選擇單元時顯示調用日歷控件（工作表代碼）Private Sub Calendar1_Click() With Calendar1 ActiveCell = .Value .Visible = False End WithEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range) If = 13 And 3 Or = 14 And 3 Then If IsDate(Target) Then = Target Else End If = 20 = + = + Cells(, 1).Left Else = 0 End IfEnd Sub39。丟失復制功能 232：添加自定義序列Sub 添加自定義序列() ListArray:=Array(優(yōu),良, 中, 差，劣)End Sub 233：彈出打印對話框Sub 彈出打印對話框()(xlDialogPrint).ShowEnd Sub 234：返回總頁碼Sub 返回總頁碼() Dim a a = ExecuteExcel4Macro((50)) Range(A1) = aEnd Sub 235：合并各工作表內容Sub 合并各工作表內容()sp = InputBox(各表內容之間，間隔幾行？不輸則默認為0)If sp = Thensp = 0End Ifst = InputBox(各表從第幾行開始合并？不輸則默認為2)If st = Then st = 2End IfSheets(1).SelectIf st 1 Then Sheets(2).Select Rows(1: amp。 CStr(st 1)).Select Sheets(1).Select Range(A1).Select y = st 1End IfFor i = 2 To Sheets(i).Select For v = 1 To 256 zd = Cells(65535, v).End(xlUp).Row If zd x Then x = zd End If Next vIf y + x st + 1 + sp 65536 ThenMsgBox 內容太多，僅合并前 amp。 i 2 amp。 個表的內容，請把其它表復制到新工作薄里再用此程序合并！Else:Rows(st amp。 : amp。 x).SelectSheets(1).SelectRange(A amp。 CStr(y + 1)).SelectSheets(i).SelectRange(A1).Select 39。取消單元格被全選狀態(tài)。 = False 39。忘掉復制的內容。End Ify = y + x st + 1 + spx = 0Next iSheets(1).SelectRange(A1).Select 39。光標移至A1。MsgBox 這就是合并后的表，請命名！End Sub 236：合并指定目錄中所有文件中相同格式工作表的數(shù)據(jù)Sub 合并數(shù)據(jù)() 39。合并指定目錄中所有文件中相同格式工作表的數(shù)據(jù) 39