《经典Excel VBA代码.doc》由会员分享，可在线阅读，更多相关《经典Excel VBA代码.doc（9页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、经典Excel VBA代码1VBA基础在大家的关注声中即将告一段落了，有许多经典的VBA操作我们只是作了简要的介绍，想要熟练地使用VBA还需要大家慢慢地去消化和吸收，然后在实践中总结和提高。最后我们收集了常见的VBA代码以飨广大的读者，希望对大家有所启示。Application（Excel程序）篇Application.EnableEvents= True/ False 启用/禁用所有事件Application.DisplayAlerts=True/False 显示/关闭警告框提示框Application.ScreenUpdating= True/False 显示/关闭屏幕刷新Applicat
2、ion.StatusBar = 软件报专用 在地址栏中显示文本，标题栏用Caption属性Application.Cursor = xlIBeam 设置光标形状为字形，xlWait为沙漏(等待)形，xlNormal为正常Application.WindowState = xlMinimized 窗口最小化，xlMaximized最大化，xlNormal为正常Application.ActivateMicrosoftApp xlMicrosoftWord 开启Word应用程序Application.TemplatesPath 获取工作簿模板的位置Application.CalculateFull
3、 重新计算所有打开的工作簿中的数据Application.RecentFiles.Maximum = 2 将最近使用的文档列表数设为2Application.RecentFiles(3).Open 打开最近打开的文档中的第3个文档Application.AutoCorrect.AddReplacement sweek, 软件报 自动将输入的sweek更正为软件报Application.Dialogs(xlDialogPrint).Show 显示打印文档的对话框Application.OnTime Now + TimeValue(00:00:45), process 45分钟后执行指定过程App
4、lication.OnTime TimeValue(14:00:00), process 下午2点执行指定过程Application.OnTime EarliestTime:=TimeValue(14:00:00), _Procedure:=process, Schedule:=False 取消指定时间的过程的执行工作簿/工作表篇ActiveWorkbook.Sheets.Count 获取活动工作薄中工作表数ActiveWorkbook.LinkSources(xlExcelLinks)(1) 返回当前工作簿中的第一条链接ThisWorkbook.Worksheets(“sheet2”).Vi
5、sible=xlSheetHidden 隐藏工作表，与在Excel菜单中执行“格式工作表隐藏”操作一样ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVeryHidden 隐藏工作表，不能通过在Excel菜单中执行“格式工作表取消隐藏”来重新显示工作表ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVisible 显示被隐藏的工作表ThisWorkbook.Sheets(1).ProtectContents 检查工作表是否受到保护ActiveSheet.Columns(B).CutActiveS
6、heet.Columns(F).Insert 以上两句将B列数据移至F列，原C列后的数据左移ActiveSheet.Range(“A:A”).EntireColumn.AutoFit 自动调整当前工作表A列的列宽ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues) 选中当前工作表中常量和文本单元格ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues) 选中当前工作表中常量和文本及错误值单元格ActiveSheet.UsedRan
7、ge.Rows.Count 当前工作表中已使用的行数ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(3), , 2 在第3张工作表之前添加2个新的工作表ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) 将当前工作表移至工作表的最后Worksheets(Array(“sheet1”,”sheet2”).Select 同时选择工作表sheet1和sheet2ActiveSheet.UsedRange.FormatConditions.Del
8、ete 删除当前工作表中应用的条件格式Cells.Hyperlinks.Delete 取消当前工作表中所有单元格的超链接ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName 在页脚显示文件的路径ActiveSheet.PrintPreview Enablechanges:=False 禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮单元格/单元格区域篇ActiveSheet.UsedRange.Row 获取已使用的单元格区域的第一行的行号Range(“A65536”).End(xlUp).Row 返回A列最后一行(
9、即记录的总条数)cell.Range(“A1”).HasFormula 检查单元格或单元格区域中的第一个单元格是否含有公式或cell.HasFormula 工作表中单元格是否含有公式Target.EntireColumn.Select 选择单元格所在的整个列，Target.EntireRow.Select为选择单元格所在的整行ActiveCell.Row 活动单元格所在的行号，ActiveCell.Column为活动单元格所在的列数ActiveWindow.ScrollRow = 2 将当前工作表窗口滚动到第2行ActiveWindow.ScrollColumn = 5 将当前工作表窗口滚动到
10、第5列Worksheets(sheet1).Range(A1:C5).CopyPicture xlScreen, xlBitmap 将指定的单元格区域的内容复制成屏幕快照Selection.Hyperlinks.Delete 删除所选区域的所有链接ActiveSheet.Cells(1, 1).Font.Bold = TRUE Bold属性用于设置字体是否为加粗， Size属性设置字体大小， ColorIndex属性设置字体颜色（其值为颜色索引号）， Italic属性设置字型是否为倾斜， Name属性设置字体名称ActiveSheet.Cells(1, 1).Interior.ColorInd
11、ex = 3 将单元格的背景色设置为红色IsEmpty (ActiveCell.Value) 判断活动单元格中是否有值ActiveCell.Value = UCase(ActiveCell.Value) 将当前单元格中的字符转换成大写ActiveCell.Value = StrConv(ActiveCell.Value, vbLowerCase) 将活动单元格中的字符串转换成小写ActiveCell.CurrentRegion.Select 选择当前活动单元格所在的连续的非空区域，也可以用Range(ActiveCell, UsedRange.End(xlDown).SelectActiveC
12、ell.Offset(1,0).Select 活动单元格下移一行Range(“B2”).Offset(ColumnOffset:=1)或Range(“B2”).Offset(,1) 读取指定单元格右侧单元格中的数据Range(“B2”).Offset(Rowoffset:=-1)或Range(“B2”).Offset(-1) 读取指定单元格上一行单元格中的数据Range(“A1”).Copy Range(“B1”) 复制单元格A1中的内容到B1中Range(“A1:D8”).Copy Range(“H1”) 将指定单元格区域复制到从H1开始的区域中，用Cut方法可以实现剪切操作ActiveWi
13、ndow.RangeSelection.Value = 软件报 将指定字符串输入到所选单元格区域中窗体（控件）篇Option Explicit 强制对模块内所有变量进行声明Userform1.Show 显示用户窗体Load Userform1 加载一个用户窗体,但该窗体处于隐藏状态Userform1.Hide 隐藏用户窗体Unload Userform1 或 Unload Me 卸载用户窗体Me.Height=Int(0.5 * ActiveWindow.Height) 窗体高度为当前活动窗口高度的一半，宽度用ActiveWindow. Width属性UserForm1.ComboBox1.A
14、ddItem Sheets(Sheet1).Cells(1, 1) 将指定单元格中的数据添加到复合框中ListBox1.List=MyProduct() 将数组MyProduct的值添加到列表框ListBox1中ListBox1.RowSource=”Sheet1!isum” 将工作表Sheet1中名为的isum区域的值添加到列表框中ListBox1.Selected(0) 选中列表框中的指定的条目ListBox1.RemoveItem ListBox1.ListIndex 移除列表框中选中的条目If MsgBox(“要退出吗？”,vbYesNo)vbYes Then Exit Sub 返回值
15、不为“是”，则退出Config=vbYesNo+vbQuestion+vbDefaultButton2 使用常量的组合，赋值组Config变量，并设置第二个按钮为缺省按钮MsgBox “This is the first line.” & vbNewLine & “Second line.” 在消息框中强制换行，也可用vbCrLf代替vbNewLine。MsgBox 平均值为:&Format(Application.WorksheetFunction.Average(Selection),#,#0.00),vbInformation, 显示选区平均值 应用工作表函数返回所选区域的平均值并按指定
16、显示的格式公式与函数Application.WorksheetFunction.IsNumber(“A1”) 检查指定单元格中的数据是否为数字Range(“A:A”).Find(Application.WorksheetFunction.Max(Range(“A:A”).Activate激活单元格区域A列中最大值的单元格Application.MacroOptions Macro:=”GetSum”,Category:=4 将自定义的GetSum函数指定给Excel中的“统计函数”类别Application.MacroOptions Macro:=” GetSum”, _Description
17、:=”先求和,然后再输出。” 为自定义函数GetSum进行功能说明Application.WorksheetFunction.CountA(Cell.EntireColumn) 返回该单元格所在列非空单元格的数量，所在行使用EntireRow属性Application.WorksheetFunction.CountA(Cells) 返回当前工作表中非空单元格数量图表篇ActiveSheet.ChartObjects.Delete 删除工作表中所有的ChartObject对象ActiveWorkbook.Charts.Delete 删除当前工作簿中所有的图表工作表 ActiveSheet.Cha
18、rtObjects.Count 获取当前工作表中图表的个数Worksheets(Sheet1).ChartObjects(1).Chart. _Export Filename:=C:MyChart.gif, FilterName:=GIF 将指定工作表中的图表1导出到C盘上并命名为MyChart.gif经典Excel VBA代码2EXCEL(VBA)SQL 经典写法范本汇集*A、根据本工作簿的1个表查询求和写法范本Sub 查询方法一()Set CONN = CreateObject(ADODB.Connection)CONN.Open provider=microsoft.jet.oledb.
19、4.0;extended properties=excel 8.0;data source= & ThisWorkbook.FullNamesql = select 区域,存货类, sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from sheet4$a:i where 区域= & b3 & and month(日期)= & Month(Range(F3) & group by 区域,存货类Sheets(sheet2).A5.CopyFromRecordset CONN.Execute(sql)CONN.Close: Set CONN = NothingEnd Sub-
20、Sub 查询方法二()Set CONN = CreateObject(ADODB.Connection)CONN.Open dsn=excel files;dbq= & ThisWorkbook.FullNamesql = select 区域,存货类, sum(代销仓入库数量),sum(代销仓出库数量),sum(日报数量)from sheet4$a:i where 区域= & b3 & and month(日期)= & Month(Range(F3) & group by 区域,存货类Sheets(sheet2).A5.CopyFromRecordset CONN.Execute(sql)CO
21、NN.Close: Set CONN = NothingEnd Sub*B、根据本工作簿2个表的不同类别查询求和写法范本Sub 根据入库表和回款表的区域名和月份分别求存货类发货数量和本月回款数量查询()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
22、 from (select 存货类,sum(本月发货数量) _ & as fh from 入库$ where 存货类 is not null and 区域= & b2 _ & and month(日期)= & d2 & group by 存货类) as a _ & left join (select 存货类,sum(数量) as hk from 回款$ where 存货类 _ & is not null and 区域= & b2 & and month(开票日期)= & d2 & _ & group by 存货类) as b on a.存货类=b.存货类Range(a5).CopyFromRe
23、cordset conn.Execute(Sql)End Sub*C、根据本文件夹下其他工作簿1个表区域的区域求和Sub 在工作表1汇总本文件夹下001工作薄的表1分数列查询汇总()Set conn = CreateObject(ADODB.Connection)conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xlssql = select sum(分数) from sheet1$Sheets(1).a2.CopyFromRecordset conn.Execute(sql)conn.Close: Set conn = Noth
24、ingEnd 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)co
25、nn.Close: Set conn = NothingEnd Sub-Sub 在工作表1汇总本文件夹下001工作薄的表1分数列A1:A7查询并msgbox表达汇总()Set conn = CreateObject(ADODB.Connection)Set rr = CreateObject(ADODB.recordset)conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xlssql = select sum(分数) from sheet1$a1:a7Sheets(1).A8.CopyFromRecordset conn.Exe
26、cute(sql)rr.Open sql, conn, 3, 1, 1MsgBox rr.fields(0)conn.Close: Set conn = NothingEnd Sub*D、根据本文件夹下其他工作簿多个表区域的单列区域查询求和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
27、 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 =
28、 DirLoopRange(d5).Resize(UBound(arr), 1) = WorksheetFunction.Transpose(arr)Application.ScreenUpdating = TrueEnd Sub*E、根据本文件夹下其他工作簿多个表区域的多列区域查询求和sub 本文件夹下其他工作簿的每个工作簿的第BCD列 25行查询求和Dim cn As Object, f$, arr&(1 To 25, 1 To 3), i%Application.ScreenUpdating = FalseSet cn = CreateObject(adodb.connection)f
29、= 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
30、 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、其他相关知识整理 用excel SQL方法conn是建立的连接对象，用open打开 通过 CreateObject(ADODB.Connection) 这一句建立了一个数据库连接对象conn 在工程中就不再需要引用“Microsot ActiveX Data Objects 2.
31、0 Library“ 对象设置对象 conn 为一个新的 ADO 链接实例,也可以用 set conn = New ADODB.Connection。- conn.Close表示关闭conn连接 Set conn = Nothing 是把连接对象conn置空，不然你退出了文件，但数据库还没有关闭conn.Open dsn=excel files;dbq= & ThisWorkbook.Path & 001.xls能把这段含义具体解释一下吗?这里的dbq的作用?-dsn是缩写，data source name数据库名 是 excel filedbq 也是缩写，data base query 意思
32、是数据库查询，后接源库文件名 001.xls-代码中长单词怎么记住的?比如copyfromrecordset可以拆开记忆，copy、from、recordset 这三个单词意思知道吧，就是“复制、从、记录集”-Sql = select sum(分数) from sheet1$这里加分数两字什么作用?SQL一般结构是select 字段 from 表，意思是从指定的表中查询字段，字段的理解可以是：表 中的列名分数 是001.xls文件的sheet1第一行A列的字段名，SQL一般以字段来识别每列数据-为什么要用复制的对象引用过来计算呢？因为Sql语句只是对源数据库的字段找到了符合条件的的数据，但不会
33、自动复制到汇总表来，所以需要复制copy注意 这里的 sheet1$ ，001文件的数据存放地上sheet1表，应当用方括号并加上$如果源数据文件001不是excel，而是Access，则引用表时，不需要加方括号，也不要$-还有,这里Execute表示什么作用? Execute是执行SQL查询语句的意思-如果不要字段也可以，那么在打开语句中加上：hdr=no这样没有分数字段也可实现SQL语句我换了形式，而且加上了hdr=no，即无需字段，而且我在SQL中用了sum(f1)，f1表示第一列数据sheet1$a1:a10 是只求a1:a10区域的和 EXCEL(VBA)SQL 经典写法范本汇集(二
34、)2008-05-10 11:21一)选择供应商和选择月份记录的查询原创:小爪 日期: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 Rang
35、e(d3) = 全部 Then Sql = select * from 数据源$a3:i1000 GoTo 100 End If If Range(b3) = 全部 Then Sql = select * from 数据源$a3:i1000 where month(日期) = & d3 & GoTo 100 End If If Range(d3) = 全部 Then Sql = select * from 数据源$a3:i1000 where 供应商= & b3 & GoTo 100 End If If Range(d3) 全部 And Range(d3) 全部 Then i = Range(
36、d3) Sql = select * from 数据源$a3:i1000 where (供应商= & b3 & ) and (month(日期) = & i & ) GoTo 100 End If 100:Sheets(统计).Range(a5).CopyFromRecordset conn.Execute(Sql) conn.Close: Set conn = NothingEnd Sub-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-二)查询某地的 收款记录工作
37、表 的收款日期,凭证号,金额,摘要 和 送货记录工作表 的发货日期,单号,金额,折扣,赠送,退货,备注原创:小爪 日期: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=
38、 & ThisWorkbook.FullName Sql1 = select 收款日期,凭证号,金额,摘要 from 收款记录$B2:F20 where 客户名称 = & b2 & Sql2 = select 发货日期,单号,金额,折扣,赠送,退货,备注 from 送货记录$B2:i20 where 客户名称 = & b2 & Sheets(套打).Range(a6).CopyFromRecordset conn.Execute(Sql1)Sheets(套打).Range(e6).CopyFromRecordset conn.Execute(Sql2) conn.Close: Set conn
39、 = NothingEnd Sub用VBA将SQL查询结果送到EXCEL指定单元格2009年09月22日 星期二 16:43（转）如何利用VBA将SQL查询结果送到EXCEL指定单元格Dim i As Integer, j As Integer, sht As Worksheet i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表Dim cn As New ADODB.Connection 定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用Dim rs As New ADODB.Recordset 定义记录集对象，保存数据表Dim strCn As String, s
40、trSQL As String 字符串变量 strCn = Provider=sqloledb;Server=(local);Database=tywk;Uid=sa;Pwd=wkserver9; 定义数据库链接字符串cn.Open strCnFINALROW = Cells(65535, 1).End(xlUp).RowSet sht = ThisWorkbook.Worksheets(更新数据库)For i = 2 To FINALROW 循环开始 strSQL = insert into tywk.dbo.表名 values( & sht.Cells(i, 1) _ & , & sht.
41、Cells(i, 2) & , & sht.Cells(i, 3) & , & sht.Cells(i, 4) _ & , & sht.Cells(i, 5) & , & sht.Cells(i, 6) & , & sht.Cells(i, 7) _ & , & sht.Cells(i, 8) & , & sht.Cells(i, 9) & , & sht.Cells(i, 10) _ & , & sht.Cells(i, 11) & , & sht.Cells(i, 12) & , & sht.Cells(i, 13) _ & , & sht.Cells(i, 14) & , & sht.Cells(i, 15) & , & sht.Cells(i, 16) _ & , & sht.Cells(i, 17) & , & sht.Cells(i, 18) & ); cn.Execute strSQLNext MsgBox 保存成功cn.Close9