ExcelVBA编程150实例大全

实用的EXCEL VBA编程小结：最近单位内部的项目里要用到些报表EXCEL的生成，虽说JAVA 的POI可以有这能力，但觉得还是可能比较麻烦，因此还是转用.net来搞，用Visual Studio2003配合office 2003，用到了一些VBA，因此小结并归纳之，选了些资料归纳在这里，以备今后查考首先创建Excel 对象，使用ComObj:Dim ExcelID as Excel.ApplicationSet ExcelID as new Excel.Application1) 显示当前窗口：ExcelID.Visible := True;2) 更改Excel 标题栏：ExcelID.Caption := '应用程序调用Microsoft Excel';3) 添加新工作簿：ExcelID.WorkBooks.Add;4) 打开已存在的工作簿：ExcelID.WorkBooks.Open( 'C:\Excel\Demo.xls' );5) 设置第2个工作表为活动工作表：ExcelID.WorkSheets[2].Activate;或ExcelID.WorkSheets[ 'Sheet2' ].Activate;6) 给单元格赋值：ExcelID.Cells[1,4].Value := '第一行第四列';7) 设置指定列的宽度（单位：字符个数），以第一列为例：ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;8) 设置指定行的高度（单位：磅）（1磅＝0.035厘米），以第二行为例：ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米9) 在第8行之前插入分页符：ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;10) 在第8列之前删除分页符：ExcelID.ActiveSheet.Columns[4].PageBreak := 0;11) 指定边框线宽度：ExcelID.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;1-左2-右3-顶4-底5-斜( \ ) 6-斜( / )12) 清除第一行第四列单元格公式：ExcelID.ActiveSheet.Cells[1,4].ClearContents;13) 设置第一行字体属性：ExcelID.ActiveSheet.Rows[1] := '隶书';ExcelID.ActiveSheet.Rows[1].Font.Color := clBlue;ExcelID.ActiveSheet.Rows[1].Font.Bold := True;ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;14) 进行页面设置：a.页眉：ExcelID.ActiveSheet.PageSetup.CenterHeader := '报表演示';b.页脚：ExcelID.ActiveSheet.PageSetup.CenterFooter := '第&P页';c.页眉到顶端边距2cm：ExcelID.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;d.页脚到底端边距3cm：ExcelID.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;e.顶边距2cm：ExcelID.ActiveSheet.PageSetup.TopMargin := 2/0.035;f.底边距2cm：ExcelID.ActiveSheet.PageSetup.BottomMargin := 2/0.035;g.左边距2cm：ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;h.右边距2cm：ExcelID.ActiveSheet.PageSetup.RightMargin := 2/0.035;i.页面水平居中：ExcelID.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035; j.页面垂直居中：ExcelID.ActiveSheet.PageSetup.CenterVertically := 2/0.035; k.打印单元格网线：ExcelID.ActiveSheet.PageSetup.PrintGridLines := True;15) 拷贝操作：a.拷贝整个工作表：ed.Range.Copy;b.拷贝指定区域：ExcelID.ActiveSheet.Range[ 'A1:E2' ].Copy;c.从A1位置开始粘贴：ExcelID.ActiveSheet.Range.[ 'A1' ].PasteSpecial;d.从文件尾部开始粘贴：ExcelID.ActiveSheet.Range.PasteSpecial;16) 插入一行或一列：a. ExcelID.ActiveSheet.Rows[2].Insert;b. ExcelID.ActiveSheet.Columns[1].Insert;17) 删除一行或一列：a. ExcelID.ActiveSheet.Rows[2].Delete;b. ExcelID.ActiveSheet.Columns[1].Delete;18) 打印预览工作表：ExcelID.ActiveSheet.PrintPreview;19) 打印输出工作表：ExcelID.ActiveSheet.PrintOut;20) 工作表保存：If not ExcelID.ActiveWorkBook.Saved then ExcelID.ActiveSheet.PrintPreviewEnd if21) 工作表另存为：ExcelID.SaveAs( 'C:\Excel\Demo1.xls' ); 22) 放弃存盘：ExcelID.ActiveWorkBook.Saved := True; 23) 关闭工作簿：ExcelID.WorkBooks.Close;24) 退出Excel：ExcelID.Quit;25) 设置工作表密码:ExcelID.ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True 26) EXCEL的显示方式为最大化ExcelID.Application.WindowState = xlMaximized27) 工作薄显示方式为最大化ExcelID.ActiveWindow.WindowState = xlMaximized28) 设置打开默认工作薄数量ExcelID.SheetsInNewWorkbook = 329) '关闭时是否提示保存(true 保存；false 不保存)ExcelID.DisplayAlerts = False30) 设置拆分窗口,及固定行位置ExcelID.ActiveWindow.SplitRow = 1ExcelID.ActiveWindow.FreezePanes = True31) 设置打印时固定打印内容ExcelID.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"32) 设置打印标题ExcelID.ActiveSheet.PageSetup.PrintTitleColumns = ""33) 设置显示方式(分页方式显示)ExcelID.ActiveWindow.View = xlPageBreakPreview34) 设置显示比例ExcelID.ActiveWindow.Zoom = 10035) 让Excel 响应DDE 请求Ex.Application.IgnoreRemoteRequests = False用VB操作EXCELPrivate Sub Command3_Click()On Error GoTo err1Dim i As LongDim j As LongDim objExl As Excel.Application '声明对象变量Me.MousePointer = 11 '改变鼠标样式Set objExl = New Excel.Application '初始化对象变量objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1objExl.Workbooks.Add '增加一个工作薄objExl.Sheets(objExl.Sheets.Count).Name = "book1" '修改工作薄名称objExl.Sheets.Add , objExl.Sheets("book1") ‘增加第二个工作薄在第一个之后objExl.Sheets(objExl.Sheets.Count).Name = "book2"objExl.Sheets.Add , objExl.Sheets("book2") ‘增加第三个工作薄在第二个之后objExl.Sheets(objExl.Sheets.Count).Name = "book3"objExl.Sheets("book1").Select '选中工作薄For i = 1 To 50 '循环写入数据For j = 1 To 5If i = 1 ThenobjExl.Selection.NumberFormatLocal = "@" '设置格式为文本objExl.Cells(i, j) = " E " & i & jElseobjExl.Cells(i, j) = i & jEnd IfNextNextobjExl.Rows("1:1").Select '选中第一行objExl.Selection.Font.Bold = True '设为粗体objExl.Selection.Font.Size = 24 '设置字体大小objExl.Cells.EntireColumn.AutoFit '自动调整列宽objExl.ActiveWindow.SplitRow = 1 '拆分第一行objExl.ActiveWindow. SplitColumn = 0 '拆分列objExl.ActiveWindow.FreezePanes = True '固定拆分objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" '设置打印固定行objExl.ActiveSheet.PageSetup.PrintTitleColumns = "" '打印标题objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _Format(Now, "yyyy年mm月dd日hh:MM:ss")objExl.ActiveWindow.View = xlPageBreakPreview '设置显示方式objExl.ActiveWindow.Zoom = 100 '设置显示大小'给工作表加密码objExl.ActiveSheet.Protect "123", DrawingObjects:=True, _Contents:=True, Scenarios:=TrueobjExl.Application.IgnoreRemoteRequests = FalseobjExl.Visible = True '使EXCEL可见objExl.Application.WindowState = xlMaximized 'EXCEL的显示方式为最大化objExl.ActiveWindow.WindowState = xlMaximized '工作薄显示方式为最大化objExl.SheetsInNewWorkbook = 3 '将默认新工作薄数量改回3个Set objExl = Nothing '清除对象Me.MousePointer = 0 '修改鼠标Exit Suberr1:objExl.SheetsInNewWorkbook = 3objExl.DisplayAlerts = False '关闭时不提示保存objExl.Quit '关闭EXCELobjExl.DisplayAlerts = True '关闭时提示保存Set objExl = NothingMe.MousePointer = 0End Sub。

Excel VBA编程典型实例—租车管理系统在租车管理系统中，用户可以根据该系统提供的专业界面进行添加和删除车辆，并且可以按天计算费用，方便管理车辆。

通过设计该系统用户可以基本掌握VBA控件的使用，并且进一步熟悉窗体的使用。

1．练习要点●使用ActiveX控件●使用多页控件2．操作步骤（1）启动Excel 2007 将“Sheet1”重命名为“主界面”，“Sheet2”重命名为“车辆信息”。

在“主界面”工作表中添加3个命令按钮，并将其样式设置为如图13-8所示。

图13-8 设置“主界面”工作表（2）设置“车辆信息”工作表如图13-9所示。

创建图13-9 设置“车辆信息”工作表（3）打开VBE窗口，新建一个用户窗体，其命名为“车辆管理”。

在该窗体中添加1个多页控件和2个命令按钮。

并将多页控件再新建2个页，如图13-10所示。

添加控件图13-10 新建窗体并添加控件（4）将多页控件中的“Page1”、“Page2”、“Page3”、“Page4”的Caption属性分别设置为“添加车辆”、“删除车辆”、“车辆出借”和“车辆归还”，并将“CommandButton2”的Caption属性设置为“取消”，如图13-11所示。

图13-11 设置多页控件（5）在“添加车辆”页中，添加如图所示控件。

图13-12 添加控件（6）在“删除车辆”页中，添加如图13-13所示控件。

图13-13 “删除车辆”页（7）在“车辆出借”页中添加如图13-14所示的控件。

图13-14 “车辆出借”页设置多页添加控件（8）“车辆归还”页中的控件，如图13-15所示。

图13-15 “车辆归还”页（9）打开该窗体的【代码】编辑窗口，输入如下代码。

Public clgl As WorksheetPublic r, num As IntegerPublic st As StringPrivate Sub UserForm_Activate()Dim s() As StringSet clgl = Sheets("车辆信息")'获取工作表的行数num = clgl.Range("A1").CurrentRegion.Rows.Count'如果单击“主界面”中的“车辆管理”按钮If Range("m1").Value = 1 ThenMe.Caption = "车辆管理"Me.MultiPage1.Pages(0).Visible = TrueMe.MultiPage1.Pages(1).Visible = TrueMe.MultiPage1.Value = 0Me.Cmd.Caption = "增加"Me.MultiPage1.Pages(2).Visible = FalseMe.MultiPage1.Pages(3).Visible = FalseReDim s(num - 2)For i = 2 To nums(i - 2) = clgl.Cells(i, 1)Next i'将车牌号赋值给列表框Me.Cob_车牌号.List() = sr = 0End If'如果单击“主界面”中的“车辆出借”按钮If Range("m1").Value = 2 ThenMe.Caption = "车辆出借"Me.Cmd.Caption = "借出"Me.MultiPage1.Pages(0).Visible = FalseMe.MultiPage1.Pages(1).Visible = FalseMe.MultiPage1.Pages(2).Visible = TrueMe.MultiPage1.Pages(3).Visible = FalseFor i = 2 To numIf clgl.Cells(i, 5) = "" Then'将车牌号赋值给列表框Me.Cob_出借牌号.AddItem clgl.Cells(i, 1) End IfNext iMe.Txt_出借日期.Value = CStr(Date)r = 0End IfIf Range("m1").Value = 3 ThenMe.Caption = "车辆归还"Me.Cmd.Caption = "归还"Me.MultiPage1.Pages(0).Visible = FalseMe.MultiPage1.Pages(1).Visible = FalseMe.MultiPage1.Pages(2).Visible = FalseMe.MultiPage1.Pages(3).Visible = TrueFor i = 2 To numIf clgl.Cells(i, 5) <> "" Then'将出借车辆的车牌号赋值给列表框Me.Cob_归还牌照.AddItem clgl.Cells(i, 1) End IfNext iMe.Txt_归还日期.Value = CStr(Date)r = 0End Ifb_费用.Visible = FalseMe.Cmd.Enabled = TrueEnd SubPrivate Sub cmd_取消_Click()EndEnd SubPrivate Sub Cob_车牌号_Change()Set clgl = Sheets("车辆信息")num = clgl.Range("A1").CurrentRegion.Rows.Countst = Me.Cob_车牌号.Value'将单元格中的数据赋值给控件For i = 2 To numIf clgl.Cells(i, 1) = st Thenb_车型.Caption = clgl.Cells(i, 2)b_购车时间.Caption = CStr(clgl.Cells(i, 3))b_租车价格.Caption = CStr(clgl.Cells(i, 4))r = iExit SubEnd IfNext iEnd SubPrivate Sub Cob_出借牌号_Change()Set clgl = Sheets("车辆信息")num = clgl.Range("A1").CurrentRegion.Rows.Countst = Me.Cob_出借牌号.ValueFor i = 2 To numIf clgl.Cells(i, 1) = st Thenb_出借车型.Caption = clgl.Cells(i, 2)b_出借购车时间.Caption = clgl.Cells(i, 3)b_出借租车价格.Caption = clgl.Cells(i, 4)r = iExit SubEnd IfNext iEnd SubPrivate Sub Cob_归还牌照_Change()Set clgl = Sheets("车辆信息")num = clgl.Range("A1").CurrentRegion.Rows.Countst = Me.Cob_归还牌照.ValueFor i = 2 To numIf clgl.Cells(i, 1) = st Thenb_归还车型.Caption = clgl.Cells(i, 2)b_归还购车时间.Caption = CStr(clgl.Cells(i, 3))b_归还租车价格.Caption = CStr(clgl.Cells(i, 4))b_归还借出日期.Caption = CStr(clgl.Cells(i, 5))r = iExit SubEnd IfNext ib_费用.Visible = FalseMe.Cmd.Enabled = TrueEnd SubPrivate Sub MultiPage1_Click(ByVal Index As Long)'如果单击第一个页，则设置按钮为“增加”，以此类推If Me.MultiPage1.Value = 0 ThenMe.Cmd.Caption = "增加"End IfIf Me.MultiPage1.Value = 1 ThenMe.Cmd.Caption = "删除"End IfIf Me.MultiPage1.Value = 2 ThenMe.Cmd.Caption = "出借"End IfIf Me.MultiPage1.Value = 3 ThenMe.Cmd.Caption = "归还"b_费用.Visible = FalseMe.Cmd.Enabled = TrueEnd IfEnd SubPrivate Sub Cmd_Click()Dim jg As IntegerDim RMB As SingleSet clgl = Sheets("车辆信息")num = clgl.Range("A1").CurrentRegion.Rows.Count'如果单击“增加”按钮，则添加信息到“车辆信息”工作表中If Me.Cmd.Caption = "增加" ThenIf Me.Txt_车牌号.Value = "" Or Me.Txt_车型.Value = "" Or Me.Txt_购车时间.Value = "" Or Me.Txt_租车价格.Value ThenMsgBox "输入信息不完整！！！"Exit SubEnd IfFor i = 2 To numIf clgl.Cells(i, 1) = Me.Txt_车牌号.Value ThenMsgBox "该车辆已经登记！！！"Me.Txt_车牌号.Value = ""Me.Txt_车型.Value = ""Me.Txt_出借日期.Value = ""Me.Txt_购车时间.Value = ""Me.Txt_归还日期.Value = ""Me.Txt_租车价格.Value = ""Exit SubEnd IfNext inum = num + 1On Error GoTo errclgl.Cells(num, 1) = Me.Txt_车牌号clgl.Cells(num, 2) = Me.Txt_车型clgl.Cells(num, 3) = Me.Txt_购车时间clgl.Cells(num, 4) = Me.Txt_租车价格Me.Cob_车牌号.AddItem Me.Txt_车牌号.ValueExit Suberr:'如果错误，则清空控件MsgBox "输入信息格式错误！！！"Me.Txt_车牌号.Value = ""Me.Txt_车型.Value = ""Me.Txt_出借日期.Value = ""Me.Txt_购车时间.Value = ""Me.Txt_归还日期.Value = ""Me.Txt_租车价格.Value = ""End IfIf Me.Cmd.Caption = "删除" ThenIf r = 0 ThenMsgBox "请选择要删除的车辆！！！"Exit SubEnd Ifjg = MsgBox("是否要删除该车辆？", vbYesNo)'如果单击Yes按钮If jg = 6 Then'删除车辆信息clgl.Rows(r).Delete Shift:=xlUpEnd IfEnd IfIf Me.Cmd.Caption = "借出" ThenIf r = 0 ThenMsgBox "请选择借出车辆！！！"Exit SubEnd IfIf Not (IsDate(Me.Txt_出借日期.Value)) ThenMsgBox "日期格式错误！！！"Me.Txt_出借日期.Value = ""Exit SubEnd IfSheets("车辆信息").Cells(r, 5) = Me.Txt_出借日期.ValueMsgBox "操作成功！！！"EndEnd IfIf Me.Cmd.Caption = "归还" ThenIf r = 0 ThenMsgBox "请选择要归还的车辆！！！"Exit SubEnd IfIf Not (IsDate(Me.Txt_归还日期.Value)) ThenMsgBox "日期格式错误！！！"Me.Txt_归还日期.Value = ""Exit SubEnd IfIf DateValue(Me.Txt_归还日期.Value) < DateValue(b_归还借出日期.Caption) ThenMsgBox "归还日期在借出日期之前！！！"Me.Txt_归还日期.Value = ""Exit SubEnd If'计算租车费用RMB = (DateValue(Me.Txt_归还日期.Value) - DateValue(b_归还借出日期.Caption) + 1) * Sheets("车辆信息").Cells(r, 4)b_费用.Visible = Trueb_费用.ForeColor = &HFF&b_费用.Caption = "应收" & CStr(RMB) & "元租车费用！！！"Sheets("车辆信息").Cells(r, 5) = ""Me.Cmd.Enabled = FalseEnd IfEnd Sub（10）在“主界面”工作表中，设置3个命令按钮的代码如下。

EXCEL-VBA编程集结EXCEL 代码示例目录EXCEL 代码示例 (1)1.常量 (2)2.按值传递与按引用传递 (2)3.Sub过程与函数过程 (3)4.单元格常见属性和方法 (4)5.工作表常见属性方法 (6)6.显式声明变量 (6)7.对象变量 (7)8.with 语句 (11)9. If语句与Select Case语句示例 (12)10. Do loop语句实例For Next语句实例 (13)11. For each in next语句实例 (14)12.VBA代码中使用公式函数 (15)13.自定义函数 (16)14.VBA数组 (16)15.中断禁用事件 (19)16.窗体案例 (20)17.常量与枚举 (21)18.查找定位函数 (22)19.汇总工作表 (24)20.合并工作簿 (26)21.拆分工作簿 (28)1.常量2.按值传递与按引用传递3.Sub 过程与函数过程4.单元格常见属性和方法激活sheet“员工信息”从A1按行移动至字符下一个空白单元空白赋值=上一个单元格数值+1右移1列输入值：康传平右移2列输入值：4/9/2015其他操作：5.工作表常见属性方法6.显式声明变量7.对象变量8.with 语句9. If语句与Select Case语句示例10. Do loop语句实例For Next语句实例11. For each in next 语句实例12.VBA 代码中使用公式函数13.自定义函数14.VBA 数组新增sheet填入15.中断禁用事件现在时间<10点，关闭excel弹出打开VBA弹出。

以下是一个简单的VBA编程案例，用于在Excel中创建一个简单的计算器程序。

该程序将接受用户输入的数字和运算符，并返回结果。

```vbaSub Calculator()Dim num1 As DoubleDim num2 As DoubleDim operator As StringDim result As Double' 获取用户输入num1 = InputBox("请输入第一个数字")operator = InputBox("请输入运算符（+, -, *, /）")num2 = InputBox("请输入第二个数字")' 根据运算符进行计算Select Case operatorCase "+"result = num1 + num2Case "-"result = num1 - num2Case "*"result = num1 * num2Case "/"If num2 <> 0 Thenresult = num1 / num2ElseMsgBox "除数不能为零"Exit SubEnd IfCase ElseMsgBox "无效的运算符"Exit SubEnd Select' 显示结果MsgBox "结果：" & resultEnd Sub```这个程序首先通过`InputBox`函数获取用户输入的两个数字和一个运算符。

然后，使用`Select Case`语句根据运算符执行相应的计算，并显示结果。

如果用户输入了无效的运算符或除数为零，程序会显示一个错误消息。

这个简单的VBA编程案例可以帮助用户快速创建自己的计算器应用程序，并在Excel中进行基本的数值计算。

2019年ExcelVBA常用代码50例.docExcel VBA 常用代码 50 例001 。

用命令按扭打印一个 sheet1 中 B2:M30 区域中的内容?我想在Sheet2 中制件一个命令按扭, 打印表Sheet1 中的[B2:M30] 区域中的内容 ?解答：可以将打印区域设为b2 ：m30 ，然后打印，如：sheets('sheet1').printarea='b2:m30'sheets('sheet1').printout 随手写的，你可以试试看。

最简单的方法是：你先录制宏，在录制宏过程中，跑到页面设置里面，把打印范围设置到你想要的范围。

然后退出，停止录制宏，你就可以得到一些代码！002 。

能否对一列中的文字统一去掉最后一个字 ?这些文字不统一 ,有些字数多 ,有些字数少。

如何处理 ?我用 {'&-} 不行解答：=REPLACE(A1,LEN(A1),1,' ')( 在过渡列进行 )003. 能否根据单元格数值自动标记序号？各位大佬，一工作表有两列，“序号”及“金额” ，能否将金额不等于0 的行自动标上序号呢？如无现成的函数，应怎样设置？解答： Dim xuhao As Integerxuhao = 1Range('b2').SelectDo While Selection <> ''If Selection <> 0 Then= xuhaoxuhao = xuhao 1End If(1, 0).Range('a1').SelectLoop004. 求教自定义函数查询了一些自定义函数的例子都是单变量的。

自定义函数能否建立“ (As Range)。

Excel VBA_多工作簿多工作表汇总实例集锦excelvba_多工作簿多工作表汇总实例集锦1，多工作表汇总（consolidate）dimrangearray()asstringdimbkasworksheetdimshtasworksheetdimwbcountasintegerset bk=sheets(\汇总\wbcount=sheets.countredimrangearray(1towbcount-1)foreachshtinsheets<>\汇总\i=i+1rangearray(i)=\sht.range(\endifnextbk.range(\[a1].value=\姓名\endsubsubsumdemo()dimarrasvariantarr=array(\一月!r1c1:r8c5\二月!r1c1:r5c4\三月!r1c1:r9c6\withworksheets(\汇总\.consolidatearr,xlsum,true,true.value=\姓名\endwithendsub2，多工作簿汇总（consolidate）‘多工作簿汇总subconsolidateworkbook()dimrangearray()asstringdimbkasworkbookdimshtasworksheetdimwbcountasintegerwbcount=workbooks.countredimrangearray(1towbcount-1)foreachbkinworkbooks'在所有工作簿中循环ifnotbkisthisworkbookthen'非代码所在工作簿setsht=bk.worksheets(1)'提及工作簿的第一个工作表i=i+1rangearray(i)=\sht.range(\endifnextworksheets(1).range(\rangearray,xlsum,true,trueendsub3，多工作簿汇总（filesearch）'导入指定文件的数据dimmyfsasfilesearchdimmypathasstring,filename$dimiaslong,naslongdimsht1asworksheet,shasworksheetdimaa,nm$,nm1$,m,arr,r1,col1%application.scree nupdating=falsesetsht1=activesheetsetmyfs=application.filesearchmypath=thisworkbook.pathwithmyfs.newsearch.lookin=mypath.filetype=msofiletypenoteitem.filename=\if.execute(sortby:=msosortbyfilename)>0thenn=.foundfiles.countcol1=2redimmyfile(1ton)asstringfori=1tonmyfile(i)=.foundfiles(i)filename=myfile(i)aa=instrrev(filename,\nm=right(filename,len(filename)-aa)nm1=left(nm,len(nm)-4)ifnm1<>\汇总表\workbooks.openmyfile(i)dimwbasworkbooksetwb=activeworkbookm=[a65536].end(xlup) .rowarr=range(cells(3,3),cells(m,3))sht1.activatecol1=col1+1cells(2,col1)=nm'自动获取文件名cells(3,col1).resize(ubound(arr),1)=arrwb.closesavechanges:=falsesetwb=nothing endifnextelsemsgbox\该文件夹里没任何文件\endifendwith[a1].selectsetmyfs=nothingapplication.screenupdating=trueendsub‘根据上例增加了在一个工作簿中可选择多个工作表进行汇总，运用了文本框多选功能publicar,ar1,nm$subpldrwb0531()'汇总表.xls'引入选定文件的数据（预设工作表1的数据）'轻易从c列依次引入dimmyfsasfilesearchdimmypathasstring,filename$dimiaslong,naslongdimsht1asworksheet,shasworksheetdimaa,nm1$,m,arr,r1,col1%application.screenupd ating=falseonerrorresumenextsetsht1=activesheetsetmyfs=application.filesearchmypath=thisworkbook.pathwithmyfs.newsearch.lookin=mypath.filetype=msofiletypenoteitem.filename=\if.execute(sortby:=msosortbyfilename)>0thenn=.foundfiles.count\+2,col1))100:col1=2redimmyfile(1ton)asstringfori=1tonmyfile(i)=.foundfiles(i)filename=myfile(i)aa=instrrev(filename,\nm=right(filename,len(filename)-aa)nm1=left(nm,len(nm)-4)ifnm1<>\汇总表\workbooks.openmyfile(i)dimwbasworkbooksetwb=activeworkbookforeachshinsheetss=s&&\nexts=left(s,len(s)-1)ar=split(s,\userform1.showforj=0toubound(ar1)iferr.number=9thengoto100setsh=wb.sheets(ar1(j))sh.activatem=sh.[a65536].end(xlup).rowarr=range(cells(3,3),cells(m,3))sht1.activatecol1=c ol1+1cells(2,col1)=sh.[a1]cells(3,col1).formular1c1=\&nm&\&ar1(j)&‘显示引用的工作簿工作表及单元格地址cells(3,col1).auto fillrange(cells(3,col1),cells(ubound(arr)‘cells(3,col1).res ize(ubound(arr),1)=arrnextjwb.closesavechanges:=falsesetwb=nothings=\ifvartype(ar1)=8200thenerasear1endifnextelsemsgbox\该文件夹里没任何文件\endifendwith[a1].selectsetmyfs=nothingapplication.screenupdating=trueendsubiflistbox1.selected(i)=truethens=s&listbox1.list(i)&\endifnextiifs<>\s=left(s,len(s)-1)ar1=split(s,\msgbox\你挑选了\unloaduserform1elsemg=msgbox(\你没有选择任何工作表！需要重新选择吗？ifmg=6thenelseunloaduserform1endifendifendsubendsubprivatesubuserform_initialize()withme.listbox1.list=ar‘文本框赋值.liststyle=1‘文本ka挑选大方框.multiselect=1‘设置可以多挑选\提示\。

Excel VBA编程典型实例——洗涤用品销售报表为了对08年前半年的洗涤用品的销售情况进行汇总分析，可以对其进行排序和汇总。

下面主要运用“多页”控件，将分析的数据结果分别显示在【排序】和【汇总】两个选项卡中。

1．练习要点●控件的使用●Sort对象的使用2．操作步骤：（1）新建一张空白工作簿，并重命名Sheet1工作表标签为“销售表”。

然后，在该工作表中，创建如图16-8所示的表格。

图16-8 创建表格（2）在E1单元格中，绘制一个“按钮1”控件。

然后，在弹出的【指定宏】对话框中，设置【宏名】为“分析数据”；并单击【新建】按钮，如图16-9所示。

单击绘制创建表格图16-9 指定宏提示 单击【控件】组中的【插入】下拉按钮，在【表单控件】栏中，选择“按钮（窗体控件）”选项，即可在工作表中，绘制一个“按钮”控件。

（3）在弹出的模块1【代码】编辑窗口中，输入如图16-10所示的代码。

图16-10 输入代码其中，输入的代码如下：Sub 分析数据()UserForm1.ShowEnd Sub（4）插入一个用户窗体，并在【属性】窗口中，设置Caption 的属性值为“分析数据”，效果如图16-11所示。

图16-11 插入并重命名用户窗体提 示右击【工程管理器】窗口的空白处，执行【插入】|【用户窗体】命令，即可在VBE窗口中，插入一个用户窗体。

（5）在【工具箱】中，单击【多页】控件按钮。

然后，在用户窗体中，绘制该“多页”控件，效果如图16-12所示。

重命名输入输入图16-12 绘制“多页”控件提 示若【工具箱】是被隐藏的，只需单击【标准】工具栏中的【工具箱】按钮即可。

（6）选择“多页”控件按钮上的Page1和Page2页，在【属性】窗口中，分别重命名为“排序”和“汇总”名称，如图16-13所示。

图16-13 重命名“页”标签（7）绘制两个“命令按钮”控件，并分别运用【属性】窗口，重命名控件名称为“排序”和“恢复”，效果如图16-14所示。

30个有用的ExcelVBA代码（16~20）16.突出显示所选内容中的可选行突出显示可选行可以极大地提高数据的可读性。

下面是一个代码，它将立即突出显示所选内容中的可选行。

Sub HighlightAlternateRows()Dim Myrange As Range Dim Myrow As Range Set Myrange = Selection For Each Myrow In Myrange.Rows If Myrow.Row Mod 2 = 1 Then Myrow.Interior.Color = vbCyan End If Next Myrow End Sub 注意，代码中指定了颜色为vbCyan（也可以修改成：vbRed, vbGreen, vbBlue）。

17.突出显示拼错单词的单元格Excel没有像在Word或PowerPoint中那样进行拼写检查。

虽然可以按F7键进行拼写检查，但当出现拼写错误时，没有视觉提示。

使用此代码可以立即突出显示其中有拼写错误的所有单元格。

Sub HighlightMisspelledCells() Dim cl As Range For Each cl I n edRange If Not Application.CheckSpelling(wor d:=cl.Text) Then cl.Interior.Color = vbRed End IfNext cl End Sub 请注意，突出显示的单元格包含Excel认为是拼写错误的文本。

当然在许多情况下，它也会其它各种错误。

18.刷新工作簿中的所有透视表如果工作簿中有多个透视表，则可以使用此代码一次刷新所有这些透视表。

Sub RefreshAllPivotTables() Dim PT As PivotTable For Each PT In ActiveSheet.PivotTables PT.RefreshTable Next PTEnd Sub 19.将所选单元格的字母大小写改为大写虽然Excel有更改文本字母大小写的公式，但它使您可以在另一组单元格中进行更改。

Excel VBA编程典型实例——设计帮助文档帮助文档有利于用户了解应用程序的相关知识，以便帮助理解应用程序的功能。

用户可以使用专门的设计帮助文件的程序，快速的生成帮助文档。

本例使用HTML Help Workshop应用程序生成一个帮助文档，并将其指定给相应的Excel应用程序。

1．练习要点● 建立方案 ● 生成索引● 为Excel 设计帮助 2．操作步骤：（1）执行【开始】|【程序|HTML Help Workshop|HTML Help Workshop 命令，即可启动HTML Help Workshop 程序，如图21-26所示。

图12-26 启动HTML Help Workshop（2）单击工具栏中的New 按钮，即可弹出New栏中，选择project 项，如图12-27所示。

图21-27 New 对话框（3）单击New 对话框中的OK 按钮。

然后，在弹出New project 对话框中，输入目录名和文件名“D:\Excel 与VBA\光盘文件\第21章\帮助系统\3D 动态效果帮助系统”，如图21-28所示。

图21-28 输入目录名和文件名（4）在New project ——Existing Files 对话框中，启用3个复选框，如图21-29所示。

图21-29 启用复选框（5）在New project ——Table of contents 对话框中，输入指定文件的位置“D:\Excel 与VBA\启动程序 选择 输入光盘文件\第21章\帮助系统”，如图21-30所示。

图21-30 指定文件位置（6）在New project ——Index 对话框中，输入索引文件的位置“D:\Excel 与VBA\光盘文件\第21章\帮助系统”。

（7）在New project ——HTML Files 对话框中，单击Add 按钮，分别添加如图21-31所示的htm 文件。

图21-31 添加htm 文件（8）依次单击【下一步】和【完成】按钮，即可在Project 选项卡中，生成如图21-32所示的信息。

VBA范例大全目录第1章单元格选择技巧与选区统计1.1 单元格与区域选择技巧实例1 选择A列最后一个非空单元格实例2 基于指定位置的偏移量的选取实例3 选择当前列最大值实例4 选择所有负数单元格实例5 选择工作表已用区域及单元格所在区域实例6 选择数组公式区域实例7 返回单元格合集与交集实例8 选择背景色为红色的单元格实例9 选择字体为兰色之单元格实例10 选择粗线边框之单元格实例11 反向选择工作表实例12 选择单元格区域但排除首行标题实例13 每隔三行选一行实例14 选择奇数列1.2 多表单元格选择实例15 同时选择三个表的B2：B11实例16 选本表以外所有工作表的B2：B11区域实例17 选中名字包含“星期”的工作表的已用区域1.3 对选区进行基本统计实例18 提取选区地址并计数实例19 判断选区隐藏单元格个数实例20 列出隐藏单元格地址实例21 统计选区空白单元格个数实例22 统计选区公式个数实例23 计算已用行列数实例24 统计带批注之单元格个数实例25 统计选区格式为“常规”之单元格个数实例26 分别统计选区文本与字母、数字个数实例27 统计选区中负数个数1.4 本章小结第2章单元格数据处理技巧2.1 选区数字、文本及字母转换实例28 将选择区域公式转化成数值实例29 将当前区域公式转化成数值实例30 将指定区域数字格式转换为文本实例31 自动将小写转化为大写实例32 将英文转为首字母大写2.2 修改选区格式实例33 修改日期格式实例34 将选区零值替换为空实例34 将区域数据改为”万”为单位实例36 将”#”号上标显示实例37 修改任意字符为上标实例38 任意字符添加下划线实例39 任意字符上方添加着重符实例40 用工作表函数对A列数据排序2.3 修改选区数据实例41 多个单元格区域数据互换实例42 填充空白单元格实例43 填充公式实例44 批量填充单元格数据实例45 删除“不采用建议”字符所在行实例46 瞬间删除空白行实例47 瞬间删除空白单元格所在行实例48 瞬间删除选区空格实例49 行列之隐藏与取消实例50 符合三个條件则匯總数据实例51 汇总行列值2.4 控制选区的不重复值实例52 统计字符在选区的重复次数实例53 报告重复数据的地址实例54 检查重复数据重复次数实例55 统计选区不重数据个数实例56 提取列数据之不重复值实例57 提取多列数据不重复值实例58 单列不允许输入重复值实例59 双列控制不重复值实例60 跨工作表控制不重复值2.5 链接功能的使用实例61 单元格链接实例62 工作表链接实例63 删除其它工作表工作簿之数据链接实例64 删除工作表自己添加的网址及MAIL地址链接2.6 批注功能的使用实例65 快捷键添加日期批注并自动缩放实例66 批量添加批注实例67 批量删除批注实例68 将指定列数据添到加批注实例69 添加图片批注实例70 添加个性化批注实例71 批量修改批注实例72 为公式添加标注2.7 合并单元格相关操作实例73 全选合并单元格实例74 将所有合并单元格加上背景实例75 取消所有合并单元格之合并实例76 取得合并单元格的首个和末尾地址实例77 合并数据并居中实例78 合并数据并粘贴实例79 批量合并单元格实例80 恢复合并实例81 取得合并单元格数目实例82 报告合并单元格地址实例83 对所有合并单元格添加批注并注示序数实例84 将已用区域合并取消并让空白单元格等于原合并值2.8 数据查询与替换实例85 查找单价实例86 多表成绩搜索实例87 电话簿查询实例88 双循环工号查询实例89 将工作表中“PC”批量替换成电脑实例90 将所有工作表中成绩大于60者考分替换成“合格”2.9 处理名称实例91 对区域及图片、图表命名实例92 显示与隐藏名称实例93 将包含指定名称的对象隐藏实例94 利用名称动态求和2.10 其它应用实例95 发邮件及开启网址实例96 单元格数据放大实例97 产生不重复随机数实例98 将含有分割符之数据转为下拉列表实例99 生成带圈之编号实例100 单元格动态显示时间实例101 根据指定最大值和最小值求所有数据之和实例102 利用勾股定理求弦长实例103 输入三边长求三角形面积实例104 指定时间出现“会议时间到”的提示2.11 本章小结第3章条件格式及数据突现方式3.1 条件格式其它数据突现方式实例105 用黄色字体突出显示当前行实例106 黑体字体显示男生成绩实例107 灰色底纹显示优异成绩之成员实例108 对区域中最大值添加下划线实例109 对区域中超过平均值之数据加粗倾斜实例110 用彩色条标示区域值的大小实例111 列举所有颜色与索引值实例112 将重复值加上虚框实例113 圈释目标3.2 管理条件格式规则实例114 在已有条件格式区域增加条件实例115 删除区域的条件格式实例116 删除工作簿中所有的条件格式实例117 提升第三个条件优先为一3.3 本章小结第4章排序4.1 对数值和文本排序实例118 对选区数值以升序排序实例119 对选区文本以字母顺序升序排序实例120 对选区文本以笔划顺序降序排序实例121 对选区数据区分大小写排序实例122 对选区区分大小写对文本排序4.2 按颜色排序实例123 按单元格背景颜色对当前列排序实例124 按单元格字体颜色对当前列排序实例125 按单元格字体颜色扩展区域排序且有标题4.3 多条件排序实例126 双条件排序首列数值升序次列笔划降序实例127 背景色和拼音单列双条件排序4.4 本章小结第5章数据筛选5.1 单条件数据筛选实例128 筛选大于10之数据实例129 筛选小于等于300之数据实例130 筛选高于平均值之数据实例131 筛选前五个最大值实例132 筛选不包含目标之数据实例133 按颜色筛选数据5.2 多条件数据筛选实例134 排除2和12之数据实例135 排除小于5的数据但等于1时例外实例136 筛选姓曲、姓名为三个字且不包含飞之数据实例137 筛选最后一个字符不为仙且长度为2之数据5.3 去除筛选实例138 去除区域中的筛选状态实例139 去除单列筛选状态5.4 本章总结6.1 图形的基本操作实例140 生成椭圆图形并双色渐变填充图形背景实例141 修改图形边框色与宽度实例142 旋转图形实例143 图形的批量删除实例144 隐藏与显示图形实例145 移动图片并设置其填充图形背景实例146 将图片导出至硬盘实例147 将单元格区域转换成图片实例148 检测单元格是否被图片覆盖6.2 使用艺术字实例149 插入艺术字实例150 修改艺术字外形及填充色6.3 图形的综合运用实例151 将所有图形垂直与水平翻转实例152 复制签名实例153 动态旋转图形实例154 制作风扇实例155 取得指定文件夹下图片名称实例156 批量调整片适合单元格大小实例157 旋转艺术字实例158 让图片跟随鼠标实例159 根据名称显示图形实例160 批量修改复选框的值实例161 按姓名插入图片6.4 图形在窗体中的运用实例162 将工作表填充至窗体实例163 加载窗体图片实例164 窗体中预览图片实例165 随机更换图片6.5 本章小结7.1 编辑图表实例166 显示与隐藏标签、网格实例167 修改图表标题与座标轴标题实例168 用图片填充背景墙实例169 动态显示鼠标所在列数据之图表实例170 利用动态名称运态显示图表内容实例171 利用图表制作进度条实例172 批量修改数据标签实例173 随心所欲显示图表类型7.2 图表至图片之转化实例174 将图片转换成图片实例175 让图表显示在窗体中并双击更新7.3 本章小结第8章控制工作表8.1 工作表的建立、删除、改名与排序实例176 建新工作表前检查是否具有同名工作表实例177 批量新建工作表并以日期命名实例178 禁止新增工作表实例179 本工作簿及其它工作簿间移动工作表实例180 启用宏方可进入指定工作表实例181 禁止进入某工作表实例182 禁止进入指定工作表以外的工作表实例183 判断工作簿中是否包含指定工作表实例184 删除汇总表以外的所有分表实例185 删除工作簿中所有空白工作表实例186 禁止修改工作表名实例187 禁止另存为别的名称实例188 恢复所有工作表的默认名称实例189 工作表排序实例190 语音提示工作表名8.2 保存与备份工作表实例191 定时保存实例192 保存时自动备份文件8.3 工作表显示与隐藏实例193 工作表显示与隐藏实例194 显示所有的被隐藏的工作表实例195 根据分辨率调整工作表视图8.4 打开工作表实例196 后台打开EXCEL文件实例197 调用打开对话框实例198 向其它工作表实例199 打开数据库实例200 导入文本文件到工作表实例201 导出工作表到TXT实例202 调用最近打开的第三个文件实例203 每次打开都进入同一工作表8.5 工作表目录实例204 建立菜单式工作表目录实例205 在工作表建立目录实例206 在单个单元格建立工作表目录实例207 返回工作表目录8.6 用工作表播放音乐实例208 工作表播放MP3实例209 工作簿背景音乐8.7 工作表事件的运用实例210 右键查看输入选项实例211 激活工作表时提示本工作表是否空白实例212 双击提示现在的时间实例213 工作表事件在人事管理中的运用添加一个功能：滚动显示工作表8.8 本章小结第9章多工作表操作9.1 多表数据运算与透视实例215 将数据追加到分表实例216 多表求和实例217 建立多表之数据透视一实例218 建立多表之数据透视二9.2 工作表拆分实例219 当前工作表拆分到多表(乱序)实例220 当前工作表拆分到多表(有序)实例221 将多工作表拆分成同路径下多工作簿9.3 工作表合并实例222 多表数据合并实例223 多工作簿合并到本工作簿实例224 多工作簿合并到当前工作表9.4 本章小结第10章工作表页面设置与打印10.1 页面设计实例225 取得当前工作表页数实例226 页面设置（设定打印区域、设置页边距及居中方式/改缩放比例及打印方向）实例227 按条件插入分页实例228 将单元格数据转化为页脚实例229 分页小计10.2 打印实例230 一次打印多个工作表实例231 打印当前光标所在页实例232 禁止打印当前工作表10.3 本章小结第11章工作簿安全处理11.1 文件加锁实例233 指定用户名方可开启本工作簿实例234 本电脑方可打开本工作簿实例235 工作表反向加密实例236 不用密码锁定编辑区域实例237 锁定鼠标移动范围实例238 批量保护工作表11.1 文件与代码删除方式实例239 文件定时自杀实例240 文件只能使用三次实例241 VBA代码自杀实例242 删除“中国”则工作簿自杀11.3 本章小结第12章文件与目录12.1 创建与管理文件实例243 批量创建工作簿实例244 文件复制并命名实例245 修改文件创建时间实例246 生成桌面快捷方式12.2 获取文件相关属性实例247 判断文件大小及文件修改时间实例248 取得当前文件路径实例249 判断文件夹中指定文件是否存在实例250 列举指定文件夹下所有EXCEL文件实例251 报告指定文件夹下隐藏文件个数12.3 管理文件夹实例252 查看与修改目录属性实例253 列出D盘所有目录实例254 计算驱动器数目实例255 建立与删除目录实例256 打开指定目录实例257 删除空文件夹实例258 获取磁盘卷标和可用空间12.4 本章小结第13章窗体与控件13.1 窗体基本属性实例259 枚举窗体属性实例260 窗体基本属性设置实例261 窗体之装载与卸载13.2 修改窗体显示模式实例262 窗体位置在屏幕中央实例263 窗体全屏显示实例264 为窗体添加最大化简小化按钮实例265 为窗体添加图标实例266 去除窗体边框实例267 将窗体置于上层实例268 去除与复位窗体的关闭按钮实例269 让窗体在指定时间逐渐退出13.3 窗体事件的运用实例270 运行窗体时隐藏程序实例271 单击修改背景双击修改名字实例272 鼠标移过时隐藏图片控件实例273 右击窗体循环显示艺术字实例274 移动窗体时报告窗体座标实例275 将ALT+F4关闭窗体改为ESC键实例276 关闭窗体时报窗体中控件数目实例277 左键拖动窗体实例278 移动窗体的标签并显示标签座标13.4 文本框实例279 控制文本框的层次实例280 设置文本框的密码样式实例281 限制用户输入数字实例282 批量锁定文本框实例283 文本框输入完毕后自行执行命令实例284 利用微调框控制文本框数字实例285 文本框向工作表添加数据并检测重复性13.5 列表框实例286 列表框数据之导入与导出实例287 列表框追加数据实例288 两个列表框之间的内容转移实例299 动态数据列表框使用实例290 利用列表框查询成绩实例291 用列表框控件打造增强性数据有效性13.6 组合框实例292 用组合框快速输入数据实例293 添加不重复值到组合框13.7 网页控件实例294 窗体中调用网页实例295 窗体创建网页且实例296 窗体中使用滚动文字实例297 窗体中显示GIF动13.8 FLASH控件实例298 窗体中播放FLASH实例299 控制播放FLASH13.9 图片控件实例300 图片控件的缩放与排列实例301 用复合框控件图片显示实例302 让图片循环滚动实例303 用图像控件打造动态按钮13.10 窗体与控件的综合运用实例304 利用日历控件输入日期实例305 一个按钮执行两个不同程序实例306 让控件适合窗体的缩放实例307 设计验证登录框实例308 制作百叶窗效果的欢迎画面实例309 利用圆窗体与网页打造时钟13.11 本章小结第14章自定义函数14.1 数值运算类实例310 按字体色求和实例311 分数型数据求和实例312 前N位和实例313 按业务量和工龄计算提成实例314 N次方和实例315 去首尾求平均实例316 根据边长求三角形周长和面积实例317 对指定范围求和与求积14.2 引用类实例318 引用区域唯一值实例319 引用单元格格式实例320 引用区域中非空值实例321 枚举工作表名实例322 返回列号对应之英文字母14.3 文本处理类实例323 按分割符取数实例324 分离数字实例325 增强型字符连接函数实例326 从右向左查字符在某字符串的位置实例327 返回单元格之批注实例328 根据身份证号返回性别实例329 大写14.3 本章小结第15章设制界面与菜单15.1 定义EXCEL显示方式实例330 屏弊EXCEL部分显示功能（网络线/标尺/滚动条）实例331 自定义状态栏进度条实例332 增强型状态栏实例333 状态栏滚动显示日期15.2 定义功能区菜单实例334 枚举所有菜单实例335 在功能区建立自己的工具按钮实例336 添加工作表标签菜单实例337 自定义按钮图标实例338 生成一二级菜单(关机/重启/锁屏)实例339 禁用与隐藏自定义菜单项实例340 生成图表专用菜单15.3 定义快捷键实例341 禁用与启用快捷键实例342 重定义快捷键（禁用快捷键）实例343 给宏指定快捷方式15.4 定义右键菜单实例344 禁用右键前三个选项实例345 在右键中建立工作表目录实例346 为右键赋与新功能——选区缩放实例347 添加“返回首页”功能于右键15.5本章小结第16章加载宏16.1 将工作簿转为加载宏实例348 手工转换工作簿为加载宏实例349 用代码转换工作簿为加载宏16.2 加载宏加载与卸载实例350 加载与卸载加载宏16.3 本章小结第17章综合实例运用17.1 多功能通讯簿17.1.1 系统内容说明17.1.2 界面设计与系统结构17.1.3 关键技术运用17.1.4 程序代码分析16.2人事资料管理17.2.1 系统内容说明17.2.2 界面设计与系统结构17.2.3 关键技术运用17.2.4 程序代码分析17.3本章小结附录A VBA常用函数附录B VBA方法列表网上售书地址：当当网（支持货到付款）/product.aspx?product_id=20170920卓越网（支持货到付款）/mn/detailApp?qid=1206666629&ref=SR&sr=1-1&uid=168-4 015694-8839453&prodid=bkbk821275小书角/auction/item_detail-0db1-560eb15263301d3906484027f1f 46163.jhtml/auction/item_detail-0db2-aacc31b5d9fe9f0783d97d8e036 0ce02.jhtml淘书工社/auction/item_detail-0db2-e355e791faba6bba6780c15aff8f bfbc.jhtml出版社网/bookshop/bookinfo.asp?bookcode=TP057790%20&booktyp e=new中国互动网/39292中国图书网/2723817.htm金桥书城/product/545290.html王府井书店/list.asp?id=712105779读书网/book/11858361/广州购书中心/search/view.jsp?proID=998168新华成都在线/content/1-100840647.htm博库书城/kgsm/ts/2008/03/31/1288960.shtml?。