經(jīng)典Excel VBA代碼.doc

經(jīng)典Excel VBA代碼1VBA基礎(chǔ)在大家的關(guān)注聲中即將告一段落了，有許多經(jīng)典的VBA操作我們只是作了簡要的介紹，想要熟練地使用VBA還需要大家慢慢地去消化和吸收，然后在實踐中總結(jié)和提高。最后我們收集了常見的VBA代碼以饗廣大的讀者，希望對大家有所啟示。Application（Excel程序）篇Application.EnableEvents= True/ False 啟用/禁用所有事件Application.DisplayAlerts=True/False 顯示/關(guān)閉警告框提示框Application.ScreenUpdating= True/False 顯示/關(guān)閉屏幕刷新Application.StatusBar = 軟件報專用 在地址欄中顯示文本，標(biāo)題欄用Caption屬性Application.Cursor = xlIBeam 設(shè)置光標(biāo)形狀為字形，xlWait為沙漏(等待)形，xlNormal為正常Application.WindowState = xlMinimized 窗口最小化，xlMaximized最大化，xlNormal為正常Application.ActivateMicrosoftApp xlMicrosoftWord 開啟Word應(yīng)用程序Application.TemplatesPath 獲取工作簿模板的位置Application.CalculateFull 重新計算所有打開的工作簿中的數(shù)據(jù)Application.RecentFiles.Maximum = 2 將最近使用的文檔列表數(shù)設(shè)為2Application.RecentFiles(3).Open 打開最近打開的文檔中的第3個文檔Application.AutoCorrect.AddReplacement sweek, 軟件報 自動將輸入的sweek更正為軟件報Application.Dialogs(xlDialogPrint).Show 顯示打印文檔的對話框Application.OnTime Now + TimeValue(00:00:45), process 45分鐘后執(zhí)行指定過程Application.OnTime TimeValue(14:00:00), process 下午2點執(zhí)行指定過程Application.OnTime EarliestTime:=TimeValue(14:00:00), _Procedure:=process, Schedule:=False 取消指定時間的過程的執(zhí)行工作簿/工作表篇ActiveWorkbook.Sheets.Count 獲取活動工作薄中工作表數(shù)ActiveWorkbook.LinkSources(xlExcelLinks)(1) 返回當(dāng)前工作簿中的第一條鏈接ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetHidden 隱藏工作表，與在Excel菜單中執(zhí)行“格式工作表隱藏”操作一樣ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVeryHidden 隱藏工作表，不能通過在Excel菜單中執(zhí)行“格式工作表取消隱藏”來重新顯示工作表ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVisible 顯示被隱藏的工作表ThisWorkbook.Sheets(1).ProtectContents 檢查工作表是否受到保護(hù)ActiveSheet.Columns(B).CutActiveSheet.Columns(F).Insert 以上兩句將B列數(shù)據(jù)移至F列，原C列后的數(shù)據(jù)左移ActiveSheet.Range(“A:A”).EntireColumn.AutoFit 自動調(diào)整當(dāng)前工作表A列的列寬ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues) 選中當(dāng)前工作表中常量和文本單元格ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues) 選中當(dāng)前工作表中常量和文本及錯誤值單元格ActiveSheet.UsedRange.Rows.Count 當(dāng)前工作表中已使用的行數(shù)ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(3), , 2 在第3張工作表之前添加2個新的工作表ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) 將當(dāng)前工作表移至工作表的最后Worksheets(Array(“sheet1”,”sheet2”).Select 同時選擇工作表sheet1和sheet2ActiveSheet.UsedRange.FormatConditions.Delete 刪除當(dāng)前工作表中應(yīng)用的條件格式Cells.Hyperlinks.Delete 取消當(dāng)前工作表中所有單元格的超鏈接ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName 在頁腳顯示文件的路徑ActiveSheet.PrintPreview Enablechanges:=False 禁用顯示在Excel的“打印預(yù)覽”窗口中的“設(shè)置”和“頁邊距”按鈕單元格/單元格區(qū)域篇ActiveSheet.UsedRange.Row 獲取已使用的單元格區(qū)域的第一行的行號Range(“A65536”).End(xlUp).Row 返回A列最后一行(即記錄的總條數(shù))cell.Range(“A1”).HasFormula 檢查單元格或單元格區(qū)域中的第一個單元格是否含有公式或cell.HasFormula 工作表中單元格是否含有公式Target.EntireColumn.Select 選擇單元格所在的整個列，Target.EntireRow.Select為選擇單元格所在的整行ActiveCell.Row 活動單元格所在的行號，ActiveCell.Column為活動單元格所在的列數(shù)ActiveWindow.ScrollRow = 2 將當(dāng)前工作表窗口滾動到第2行ActiveWindow.ScrollColumn = 5 將當(dāng)前工作表窗口滾動到第5列Worksheets(sheet1).Range(A1:C5).CopyPicture xlScreen, xlBitmap 將指定的單元格區(qū)域的內(nèi)容復(fù)制成屏幕快照Selection.Hyperlinks.Delete 刪除所選區(qū)域的所有鏈接ActiveSheet.Cells(1, 1).Font.Bold = TRUE Bold屬性用于設(shè)置字體是否為加粗， Size屬性設(shè)置字體大小， ColorIndex屬性設(shè)置字體顏色（其值為顏色索引號）， Italic屬性設(shè)置字型是否為傾斜， Name屬性設(shè)置字體名稱ActiveSheet.Cells(1, 1).Interior.ColorIndex = 3 將單元格的背景色設(shè)置為紅色I(xiàn)sEmpty (ActiveCell.Value) 判斷活動單元格中是否有值A(chǔ)ctiveCell.Value = UCase(ActiveCell.Value) 將當(dāng)前單元格中的字符轉(zhuǎn)換成大寫ActiveCell.Value = StrConv(ActiveCell.Value, vbLowerCase) 將活動單元格中的字符串轉(zhuǎn)換成小寫ActiveCell.CurrentRegion.Select 選擇當(dāng)前活動單元格所在的連續(xù)的非空區(qū)域，也可以用Range(ActiveCell, UsedRange.End(xlDown).SelectActiveCell.Offset(1,0).Select 活動單元格下移一行Range(“B2”).Offset(ColumnOffset:=1)或Range(“B2”).Offset(,1) 讀取指定單元格右側(cè)單元格中的數(shù)據(jù)Range(“B2”).Offset(Rowoffset:=-1)或Range(“B2”).Offset(-1) 讀取指定單元格上一行單元格中的數(shù)據(jù)Range(“A1”).Copy Range(“B1”) 復(fù)制單元格A1中的內(nèi)容到B1中Range(“A1:D8”).Copy Range(“H1”) 將指定單元格區(qū)域復(fù)制到從H1開始的區(qū)域中，用Cut方法可以實現(xiàn)剪切操作ActiveWindow.RangeSelection.Value = 軟件報 將指定字符串輸入到所選單元格區(qū)域中窗體（控件）篇Option Explicit 強(qiáng)制對模塊內(nèi)所有變量進(jìn)行聲明Userform1.Show 顯示用戶窗體Load Userform1 加載一個用戶窗體,但該窗體處于隱藏狀態(tài)Userform1.Hide 隱藏用戶窗體Unload Userform1 或 Unload Me 卸載用戶窗體Me.Height=Int(0.5 * ActiveWindow.Height) 窗體高度為當(dāng)前活動窗口高度的一半，寬度用ActiveWindow. Width屬性UserForm1.ComboBox1.AddItem Sheets(Sheet1).Cells(1, 1) 將指定單元格中的數(shù)據(jù)添加到復(fù)合框中ListBox1.List=MyProduct() 將數(shù)組MyProduct的值添加到列表框ListBox1中ListBox1.RowSource=”Sheet1!isum” 將工作表Sheet1中名為的isum區(qū)域的值添加到列表框中ListBox1.Selected(0) 選中列表框中的指定的條目ListBox1.RemoveItem ListBox1.ListIndex 移除列表框中選中的條目If MsgBox(“要退出嗎？”,vbYesNo)vbYes Then Exit Sub 返回值不為“是”，則退出Config=vbYesNo+vbQuestion+vbDefaultButton2 使用常量的組合，賦值組Config變量，并設(shè)置第二個按鈕為缺省按鈕MsgBox “This is the first line.” & vbNewLine & “Second line.” 在消息框中強(qiáng)制換行，也可用vbCrLf代替vbNewLine。MsgBox 平均值為:&Format(Application.WorksheetFunction.Average(Selection),#,#0.00),vbInformation, 顯示選區(qū)平均值 應(yīng)用工作表函數(shù)返回所選區(qū)域的平均值并按指定顯示的格式公式與函數(shù)Application.WorksheetFunction.IsNumber(“A1”) 檢查指定單元格中的數(shù)據(jù)是否為數(shù)字Range(“A:A”).Find(Application.WorksheetFunction.Max(Range(“A:A”).Activate激活單元格區(qū)域A列中最大值的單元格Application.MacroOptions Macro:=”GetSum”,Category:=4 將自定義的GetSum函數(shù)指定給Excel中的“統(tǒng)計函數(shù)”類別Application.MacroOptions Macro:=” GetSum”, _Description:=”先求和,然后再輸出。” 為自定義函數(shù)GetSum進(jìn)行功能說明Application.WorksheetFunction.CountA(Cell.EntireColumn) 返回該單元格所在列非空單元格的數(shù)量，所在行使用EntireRow屬性Application.WorksheetFunction.CountA(Cells) 返回當(dāng)前工作表中非空單元格數(shù)量圖表篇ActiveSheet.ChartObjects.Delete 刪除工作表中所有的ChartObject對象ActiveWorkbook.Charts.Delete 刪除當(dāng)前工作簿中所有的圖表工作表 ActiveSheet.ChartObjects.Count 獲取當(dāng)前工作表中圖表的個數(shù)Worksheets(Sheet1).ChartObjects(1).Chart. _Export Filename:=C:MyChart.gif, FilterName:=GIF 將指定工作表中的圖表1導(dǎo)出到C盤上并命名為MyChart.gif經(jīng)典Excel VBA代碼2EXCEL(VBA)SQL 經(jīng)典寫法范本匯集*A、根據(jù)本工作簿的1個表查詢求和寫法范本Sub 查詢方法一()Set CONN = CreateObject(ADODB.Connection)CONN.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= & ThisWorkbook.FullNamesql = select 區(qū)域,存貨類, sum(代銷倉入庫數(shù)量),sum(代銷倉出庫數(shù)量),sum(日報數(shù)量)from sheet4$a:i where 區(qū)域= & b3 & and month(日期)= & Month(Range(F3) & group by 區(qū)域,存貨類Sheets(sheet2).A5.CopyFromRecordset CONN.Execute(sql)CONN.Close: Set CONN = NothingEnd Sub-Sub 查詢方法二()Set CONN = CreateObject(ADODB.Connection)CONN.Open dsn=excel files;dbq= & ThisWorkbook.FullNamesql = select 區(qū)域,存貨類, sum(代銷倉入庫數(shù)量),sum(代銷倉出庫數(shù)量),sum(日報數(shù)量)from sheet4$a:i where 區(qū)域= & b3 & and month(日期)= & Month(Range(F3) & group by 區(qū)域,存貨類Sheets(sheet2).A5.CopyFromRecordset CONN.Execute(sql)CONN.Close: Set CONN = NothingEnd Sub*B、根據(jù)本工作簿2個表的不同類別查詢求和寫法范本Sub 根據(jù)入庫表和回款表的區(qū)域名和月份分別求存貨類發(fā)貨數(shù)量和本月回款數(shù)量查詢()Set conn = CreateObject(adodb.connection)conn.Open provider=microsoft.jet.oledb.4.0; & _ extended properties=excel 8.0;data source= & ThisWorkbook.FullNameSheet3.ActivateSql = select a.存貨類,a.fh ,b.hk from (select 存貨類,sum(本月發(fā)貨數(shù)量) _ & as fh from 入庫$ where 存貨類 is not null and 區(qū)域= & b2 _ & and month(日期)= & d2 & group by 存貨類) as a _ & left join (select 存貨類,sum(數(shù)量) as hk from 回款$ where 存貨類 _ & is not null and 區(qū)域= & b2 & and month(開票日期)= & d2 & _ & group by 存貨類) as b on a.存貨類=b.存貨類Range(a5).CopyFromRecordset conn.Execute(Sql)End Sub*C、根據(jù)本文件夾下其他工作簿1個表區(qū)域的區(qū)域求和Sub 在工作表1匯總本文件夾下001工作薄的表1分?jǐn)?shù)列查詢匯總()Set conn = CreateObject(ADODB.Connection)conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xlssql = select sum(分?jǐn)?shù)) from sheet1$Sheets(1).a2.CopyFromRecordset conn.Execute(sql)conn.Close: Set conn = NothingEnd Sub-Sub 在工作表1匯總本文件夾下001工作薄的表1A1:A10查詢匯總()Set conn = CreateObject(ADODB.Connection)conn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;hdr=no;data source= & ThisWorkbook.Path & 001.xlssql = select sum(f1) from sheet1$a1:a10Sheets(1).A5.CopyFromRecordset conn.Execute(sql)conn.Close: Set conn = NothingEnd Sub-Sub 在工作表1匯總本文件夾下001工作薄的表1分?jǐn)?shù)列A1:A7查詢并msgbox表達(dá)匯總()Set conn = CreateObject(ADODB.Connection)Set rr = CreateObject(ADODB.recordset)conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xlssql = select sum(分?jǐn)?shù)) from sheet1$a1:a7Sheets(1).A8.CopyFromRecordset conn.Execute(sql)rr.Open sql, conn, 3, 1, 1MsgBox rr.fields(0)conn.Close: Set conn = NothingEnd Sub*D、根據(jù)本文件夾下其他工作簿多個表區(qū)域的單列區(qū)域查詢求和sub 本文件夾下其他工作簿的每個工作簿的第4列 30行查詢求和Dim cn As Object, f$, arr&(1 To 30), i%Application.ScreenUpdating = FalseSet cn = CreateObject(adodb.connection)f = Dir(ThisWorkbook.Path & *.xls)Do While f If f ThisWorkbook.Name Then cn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;hdr=no;data source= & ThisWorkbook.Path & & f Range(d5).CopyFromRecordset cn.Execute(select f4 from 基表1$a5:d65536) cn.Close For i = 1 To 30 arr(i) = arr(i) + Range(d & i + 4) Next i End If f = DirLoopRange(d5).Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)Application.ScreenUpdating = TrueEnd Sub*E、根據(jù)本文件夾下其他工作簿多個表區(qū)域的多列區(qū)域查詢求和sub 本文件夾下其他工作簿的每個工作簿的第BCD列 25行查詢求和Dim cn As Object, f$, arr&(1 To 25, 1 To 3), i%Application.ScreenUpdating = FalseSet cn = CreateObject(adodb.connection)f = Dir(ThisWorkbook.Path & *.xls)Do While f If f ThisWorkbook.Name Then cn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;hdr=no;data source= & ThisWorkbook.Path & & f Range(b6).CopyFromRecordset cn.Execute(select f2,f3,f4 from 基表3$a6:e65536) cn.Close For i = 1 To 25 For j = 1 To 3 arr(i, j) = arr(i, j) + Cells(i + 5, j + 1) Next j Next i End If f = DirLoopRange(b6).Resize(UBound(arr), 3) = arrApplication.ScreenUpdating = TrueEnd Sub*F、其他相關(guān)知識整理 用excel SQL方法conn是建立的連接對象，用open打開 通過 CreateObject(ADODB.Connection) 這一句建立了一個數(shù)據(jù)庫連接對象conn 在工程中就不再需要引用“Microsot ActiveX Data Objects 2.0 Library“ 對象設(shè)置對象 conn 為一個新的 ADO 鏈接實例,也可以用 set conn = New ADODB.Connection。- conn.Close表示關(guān)閉conn連接 Set conn = Nothing 是把連接對象conn置空，不然你退出了文件，但數(shù)據(jù)庫還沒有關(guān)閉conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xls能把這段含義具體解釋一下嗎?這里的dbq的作用?-dsn是縮寫，data source name數(shù)據(jù)庫名 是 excel filedbq 也是縮寫，data base query 意思是數(shù)據(jù)庫查詢，后接源庫文件名 001.xls-代碼中長單詞怎么記住的?比如copyfromrecordset可以拆開記憶，copy、from、recordset 這三個單詞意思知道吧，就是“復(fù)制、從、記錄集”-Sql = select sum(分?jǐn)?shù)) from sheet1$這里加分?jǐn)?shù)兩字什么作用?SQL一般結(jié)構(gòu)是select 字段 from 表，意思是從指定的表中查詢字段，字段的理解可以是：表 中的列名分?jǐn)?shù) 是001.xls文件的sheet1第一行A列的字段名，SQL一般以字段來識別每列數(shù)據(jù)-為什么要用復(fù)制的對象引用過來計算呢？因為Sql語句只是對源數(shù)據(jù)庫的字段找到了符合條件的的數(shù)據(jù)，但不會自動復(fù)制到匯總表來，所以需要復(fù)制copy注意 這里的 sheet1$ ，001文件的數(shù)據(jù)存放地上sheet1表，應(yīng)當(dāng)用方括號并加上$如果源數(shù)據(jù)文件001不是excel，而是Access，則引用表時，不需要加方括號，也不要$-還有,這里Execute表示什么作用? Execute是執(zhí)行SQL查詢語句的意思-如果不要字段也可以，那么在打開語句中加上：hdr=no這樣沒有分?jǐn)?shù)字段也可實現(xiàn)SQL語句我換了形式，而且加上了hdr=no，即無需字段，而且我在SQL中用了sum(f1)，f1表示第一列數(shù)據(jù)sheet1$a1:a10 是只求a1:a10區(qū)域的和 EXCEL(VBA)SQL 經(jīng)典寫法范本匯集(二)2008-05-10 11:21一)選擇供應(yīng)商和選擇月份記錄的查詢原創(chuàng):小爪 日期:2008-5-10Private Sub CommandButton1_Click()Range(a5:k1000).ClearContentsSet conn = CreateObject(ADODB.Connection) conn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;imex=1;data source= & ThisWorkbook.FullName If Range(b3) = 全部 And Range(d3) = 全部 Then Sql = select * from 數(shù)據(jù)源$a3:i1000 GoTo 100 End If If Range(b3) = 全部 Then Sql = select * from 數(shù)據(jù)源$a3:i1000 where month(日期) = & d3 & GoTo 100 End If If Range(d3) = 全部 Then Sql = select * from 數(shù)據(jù)源$a3:i1000 where 供應(yīng)商= & b3 & GoTo 100 End If If Range(d3) 全部 And Range(d3) 全部 Then i = Range(d3) Sql = select * from 數(shù)據(jù)源$a3:i1000 where (供應(yīng)商= & b3 & ) and (month(日期) = & i & ) GoTo 100 End If 100:Sheets(統(tǒng)計).Range(a5).CopyFromRecordset conn.Execute(Sql) conn.Close: Set conn = NothingEnd Sub-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-二)查詢某地的 收款記錄工作表 的收款日期,憑證號,金額,摘要 和 送貨記錄工作表 的發(fā)貨日期,單號,金額,折扣,贈送,退貨,備注原創(chuàng):小爪 日期:2008-5-6實例地址:E:歡樂-office小爪-excel小爪-vbaADO+SQLPrivate Sub CommandButton1_Click()Range(a6:k16).ClearContentsSet conn = CreateObject(ADODB.Connection) conn.Open provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;imex=1;data source= & ThisWorkbook.FullName Sql1 = select 收款日期,憑證號,金額,摘要 from 收款記錄$B2:F20 where 客戶名稱 = & b