EXCEL常用VBA代碼

1、刪除B列中字符串?dāng)?shù)值少于21的單元格所在的行Sub 刪除行()r = Range("B65536").End(xlUp).Row '行數(shù)For h = r To 1 Step -1 If Cells(h, 2) < 21 Then Cells(h, 2).EntireRow.Delete NextEnd Sub -【工作表合并】將同一工作簿中的所有工作表合并到一個(gè)工作表中新建一個(gè)工作表，寫入代碼在新建的工作表標(biāo)簽處右鍵 查看代碼（找不到的直接按一下alt+F11) 把下面 的代碼復(fù)制進(jìn)去 然后點(diǎn)上面的運(yùn)行 運(yùn)行子程序即可：Sub 合并當(dāng)前工作簿下的所有工作表(

2、)Application.ScreenUpdating = FalseFor j = 1 To Sheets.Count If Sheets(j).Name <> ActiveSheet.Name Then X = Range("A65536").End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End IfNextRange("B1").SelectApplication.ScreenUpdating = TrueMsgBox "當(dāng)前工作簿下的全部工作表已經(jīng)合并完畢！&q

3、uot;, vbInformation, "提示"End Sub*代碼這樣寫也行：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).SelectSheets(i).UsedRange.CopySheets(1).SelectCells(Cells(65000, 1).End(xlUp).Row + 1, 1).SelectActiveSheet.Paste'Sheets(i).DeleteNext iEnd Sub*把一個(gè)工作簿中的所有表單合并成一個(gè)表單，怎么去掉重復(fù)的表頭、標(biāo)題行？方法如下：Sub c()For i

4、 = Sheets.Count To 2 Step -1Sheets(i).UsedRange.Offset(1).Copy Sheets(1).Cells(65536, 1).End(xlUp).Offset(1)Next iEnd Sub說(shuō)明：函數(shù)OFFSET(reference,rows,cols,height,width)以指定的引用為參照系，通過(guò)給定偏移量得到新的引用。返回的引用可以為一個(gè)單元格或單元格區(qū)域。并可以指定返回的行數(shù)或列數(shù)。通俗的講就是OFFSET(參考單元格，移動(dòng)的行數(shù)，移動(dòng)的列數(shù)，所要引用的行數(shù)，所要引用的列數(shù)） 參考關(guān)于offset函數(shù)第三行中第一個(gè)offset(1

5、)是假設(shè)要要去掉的表頭行數(shù)，如果有2行表頭，就改成offset(2)，要去掉幾行表頭括號(hào)中的數(shù)字就改成幾。第二個(gè)offset(1)表示合并以后表格與表格之間要間隔的空行，offset(1)表示不留空行，offset(2)表示間隔1行空行，以此類推。也可以這樣寫：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).UsedRange.Offset(2).Copy Sheets(1).Cells(Cells(65536, 1).End(xlUp).Row + 1, 1).Offset(0) 這個(gè)offset(0)可以不要Next iEnd Sub*或

6、者用以下宏代碼將同一工作簿中的所有工作表合并到一個(gè)新建的工作表中按ALT+F11調(diào)出窗口，插入一個(gè)模塊，然后把下面的代碼復(fù)制進(jìn)去。Sub hz() Set NewSheet = Sheets.Add(Type:=xlWorksheet) '生成一個(gè)新表 Sheets(NewSheet.Index).Move Before:=Sheets(1) '將此新表移動(dòng)到最前面 For i = 2 To Worksheets.Count Sheets(i).UsedRange.Copy NewSheet.Cells(a65536.End(xlUp).Row + 2, 1) '將其他

7、表的已使用區(qū)域復(fù)制到新表中 Next i MsgBox "合并完成"End Sub這段代碼很簡(jiǎn)單，其中第四行中用FOR循環(huán)得到當(dāng)前工作簿中的所有工作表，第五行中使用UsedRange得到每個(gè)工作表的“已使用區(qū)域”，然后用copy方法把這些“已使用區(qū)域”中的內(nèi)容復(fù)制到新建工作表中。語(yǔ)句Cells(a65536.End(xlUp).Row + 2, 1)的作用是得到新建工作表的列中的最后空白單元格(即要在哪個(gè)位置粘貼)，加2的作用是使每次復(fù)制數(shù)據(jù)間隔2行空格（此處應(yīng)表示間隔1行空格，加1的話，表示合并的表格與表格之間不留空格）?；氐紼XCEL窗口，執(zhí)行“工具-宏-宏”中的“hz

8、”宏就會(huì)自動(dòng)合并工作表了。（經(jīng)本人測(cè)試，不能使用右鍵點(diǎn)擊標(biāo)簽查看代碼再粘入代碼的方式，應(yīng)該運(yùn)用菜單欄插入模塊的方式）-【工作簿合并】將需要合并的工作簿文件放置在一個(gè)文件夾中，并新建一個(gè)工作簿，寫入代碼：Sub 合并工作薄()Dim FilesToOpenDim x As IntegerOn Error GoTo ErrHandlerApplication.ScreenUpdating = FalseFilesToOpen = Application.GetOpenFilename _(FileFilter:="MicroSoft Excel文件(*.xls), *.xls"

9、, _MultiSelect:=True, Title:="要合并的文件")If TypeName(FilesToOpen) = "Boolean" ThenMsgBox "沒(méi)有選中文件"GoTo ExitHandlerEnd Ifx = 1While x <= UBound(FilesToOpen)Workbooks.Open Filename:=FilesToOpen(x)Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)x = x + 1W

10、endExitHandler:Application.ScreenUpdating = TrueExit SubErrHandler:MsgBox Err.DescriptionResume ExitHandlerEnd Sub-顯示隱藏的工作表Sub ShowAllSheets() '使當(dāng)前工作簿中的所有工作表都顯示(即將隱藏的工作表也顯示)" Dim ws As Worksheet For Each ws In Sheets ws.Visible = True Next wsEnd Sub-根據(jù)Sheet2中的數(shù)據(jù)，檢查Sheet1中的重復(fù)數(shù)據(jù)，并且進(jìn)行后續(xù)的操作（將重復(fù)

11、數(shù)據(jù)刪除或者拷貝出來(lái)）的操作。Application.ScreenUpdating = False C = 2 '第一個(gè)工作表檢測(cè)B列 X = 1 '第一條檢測(cè)結(jié)果放在第1行 Count = 1 First_sheet_row = Sheets(1).Cells(65536, C).End(xlUp).Row Second_sheet_row = Sheets(2).Cells(65536, C).End(xlUp).Row Dim To_be_deleted(5369) As String For j = 1 To 5368 To_be_deleted(j) = Trim(C

12、Str(Sheets(2).Cells(j, 2).Value) Next j For i = 1 To First_sheet_row First_value = Trim(CStr(Sheets(1).Cells(i, C).Value) For j = 1 To 5368 'MsgBox To_be_deleted(j) If First_value = To_be_deleted(j) Then Sheets(1).Range("A" & CStr(i) & ":Ag" & i).Delete Sheets(2).

13、Cells(j, 4).Value = "Copied" 'Sheets(2).Cells(j, 3).Value = "Copied" 'Application.CutCopyMode = False 'Sheets(1).Range("A" & CStr(i) & ":Ag" & i).Copy 'Sheets(3).Paste Destination:=Sheets(3).Range("A" & i) 'Sheets(

14、3).Paste Count = Count + 1 i = i - 1 End If Next j Next i Application.ScreenUpdating = True MsgBox "共刪除了" & Count這個(gè)腳本中有一些優(yōu)化的地方，原來(lái)進(jìn)行數(shù)據(jù)比較時(shí)，都是使用直接Cell(x,y)的方式訪問(wèn)并對(duì)比，另外也是分別循環(huán)，效率非常低，Excel一直處于假死的狀態(tài)。后來(lái)，先將比較小的一份數(shù)據(jù)拷貝到數(shù)組中，然后再進(jìn)行循環(huán)，這樣效率就提高了很多。-合并目錄中具有同樣數(shù)據(jù)格式的多個(gè)Excel文件Dim MyPath, MyName, AWbName Dim

15、Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName <> "" If MyName <>

16、 AWbName Then Set Wb = Workbooks.Open(MyPath & "" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").En

17、d(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "個(gè)工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" -奇

18、偶頁(yè)分別打印 Sub 奇偶頁(yè)分別打印() Dim i%, Ps% Ps = ExecuteExcel4Macro(“GET.DOCUMENT(50)”) 總頁(yè)數(shù) MsgBox “現(xiàn)在打印奇數(shù)頁(yè),按確定開(kāi)始.” For i = 1 To Ps Step 2 ActiveSheet.PrintOut from:=i, To:=i Next i MsgBox “現(xiàn)在打印偶數(shù)頁(yè),按確定開(kāi)始.” For i = 2 To Ps Step 2 ActiveSheet.PrintOut from:=i, To:=i Next i End Sub -將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小 S

19、ub 將A列最后數(shù)據(jù)行以上的所有B列圖片大小調(diào)整為所在單元大小() Dim Pic As Picture, i& i = A65536.End(xlUp).Row For Each Pic In Sheet1.Pictures If Not Application.Intersect(Pic.TopLeftCell, Range(“B1:B” & i) Is Nothing Then Pic.Top = Pic.TopLeftCell.Top Pic.Left = Pic.TopLeftCell.Left Pic.Height = Pic.TopLeftCell.Height

20、Pic.Width = Pic.TopLeftCell.Width End If Next End Sub 如何在原有行高的基礎(chǔ)上增加一個(gè)固定值 Private Sub CommandButton1_Click() Dim i, HangGao Rows("1:100").EntireRow.AutoFit HangGao = InputBox("已設(shè)定自適應(yīng)行高，設(shè)定想增加的行高", "增加行高") Application.ScreenUpdating = False For i = 1 To 100 Rows(i).RowHeig

21、ht = Rows(i).RowHeight + CVar(HangGao) Next i Application.ScreenUpdating = TrueEnd Sub代碼的意思是：選中前100行，然后自動(dòng)根據(jù)內(nèi)容調(diào)整到合適的行高，就跟你選中以后雙擊黑線是一樣的效果。然后在彈出的對(duì)話框中輸入你想要每行增加行高的數(shù)值，比如說(shuō)輸入23，每個(gè)行高就加23.-其他解釋：Range是區(qū)域，范圍的意思range("A1")對(duì)一個(gè)單元格集合進(jìn)行范圍篩選(只選中最左上角的1個(gè)單元格)，比如 sheet1.range("A1:C3").select將選中sheet1的左上角的9個(gè)單元格選中。1、Range 屬性Range(arg)（其中 arg 為區(qū)域名稱）來(lái)返回代表單個(gè)單元格或單元格區(qū)域的 Range 對(duì)象 2、Cells 屬性可用 Cells(row,column）（其中 row 為行號(hào)，column 為列標(biāo)）返回單個(gè)單元格3、Range 和 Cells可用 Range(cell1,cel