VBA基础知识普及常用代码大全菜单工具栏打开关闭工作簿函数调用图表修改返回最后一行.doc

目 录前言2正文2第一局部 根本知识简介21激活、选择对象22引用单元格2引用单个单元格2引用区域34选中/删除/剪切/插入/隐藏行或列34.1 选中行或列34.2 删除行或列34.3 剪切行或列44.4 插入行或列44.5 隐藏行或列45复制并粘贴45.1 复制并选择性粘贴45.2 复制并粘贴56循环语句56.1 Do While 循环56.2 Do Until循环56.3 For Next 循环57 if Then end if 语句68 With语句69去除单元格数据710 InputBox、MsgBox710.1 InputBox函数710.2 MsgBox函数811 Sub函数与Fountion函数8函数结构811.2 Sub函数与Fountion函数9函数举例912提高VBA代码运行速度的重要代码9第二局部常用代码大全101添加自定义菜单代码102添加自定义工具栏代码114启开工作簿自动运行宏13pen 事件13用Auto_Open宏135 VBA调用函数的方法146 sub 的递归147 userange函数找到数据边界158 End (xldown) 和End(xlup)语句159修改图表数据系列的引用数据1610窗体制作代码1611翻开相应路径的工作表1712以B2：B10为主要关键字排序17前言本文前半局部适用于初学VBA根底的人，后半局部的常用代码在初学者乍看起来可能有点难度，但是初学者可以将本文档中的代码复制下来放到Excel VBA窗口中试运行，学习起来会事半功倍。本文第一局部简要讲解了VBA根底对象操作的根底知识。学会了这些，就能编制一些简单的含有常用的根本功能的VBA代码。第二局部是一些非常有用的VBA代码，涵盖了添加自定义菜单、添加自定义工具栏、翻开关闭工作簿、函数调用、Sub函数递归、寻找并返回数据区域边界、自定义排序、制作窗体代码、修改图表数据引用、启开工作簿自动运行VBA代码、通过VBA输入公式等等，涵盖了大局部常用重要的功能。希望能给大家带来帮助。作者水平有限，消耗一晚写成，文中纰漏在所难所，望读者批准指正。正文在进行Excel VBA编程的过程中，无时无刻不在接触与使用对象。在Excel VBA中，操作和设置的主体都是对象，这是因为Excel应用程序是由对象组成的，大到Excel本身，小到一个单元格，它们都是对象。VBA对象有ApplicationWorkbookWorksheetrange翻开VBA编辑窗口： 翻开VBA窗口的快捷键：alt+F11。也可以依次点击开发工具Visual Basic新建模块在模块中输入VBA代码。也可以在MicroSoft Excel对象中输入代码。第一局部 根本知识简介1激活、选择对象Sheets("工作表名").Activate 激活工作表Sheets("工作表名").Select 选择工作表Range(A1).Select 选择A1单元格2引用单元格如果要引用C4单元格，有以下几种方式： Workbook("工作表名").Worksheets("工作簿名").Range ("C4")注意可以简写成Sheets("工作簿名").Range ("C4") Sheets.Cells (4, 3)如果要引用C3到C10Range ("C3:C10")同理如果要引用C3到F10Range ("C3:F10")到这里你可能要问了，假设把10换成变量y呢? Range ("C3:F" & y) 那么假设3也换成变量x呢? Range ("C" & x & ":F" & y)如果更进一步你可能又要问了，假设C和F都是变量怎么办，还能引用吗？如果要实现这样一种功能：通过VBA代码给单元格B10 写入公式：=COUNTIF($C$2:$F$9,"*立项*")(注释：这个公式的意义：在C2:F9中统计含有立项内容的单元格个数)，如果C和F、2和9都是变量怎么办？请看下文：定义行号用变量x(x1,x2)表示，列号用y(y1,y2)表示，那么代码如下Sheets("工作表名").Cells(10, 2).FormulaR1C1 = "=COUNTIF(R" & x1 & "C" & y1 & ":R" & x2 & "C" & y2 & ",""*立项*"")"4选中/删除/剪切/插入/隐藏行或列 选中行或列选中第5行的代码如下 Rows(5).select或者Rows(“5:5).select选中第5行到第10行的代码如下 Rows(“5:10).select选中第C列到第E列的代码如下 Columns("C:E").SelectEntirecolumn属性、Entirerow属性Range("A3").Entirecolumn 表示A列 Range("A3").Entirerow 表示第3行 删除行或列删除第2行代码如下Sub 删除行 ()Sheets(“工作表名).Rows(2).DeleteEnd Sub删除第3列到第5列的代码如下Sub 删除列 () Sheets(“工作表名).Columns("C:E").SelectEnd Sub4.3 剪切行或列Sheets(“工作表名).Rows(2).Cut 剪切第2行Sheets(“工作表名). .Columns("C:E").Cut 剪切C列到E列4.4 插入行或列代码1Sub 在第2行插入1行() Rows(2).SelectEnd Sub代码2Sub 在第2行插入3行() Rows(“2:4).SelectEnd Sub代码3Sub 在C列插入1列() Columns("C:C").SelectEnd Sub代码4Sub 在C列插入3列() Columns("C:E").SelectEnd Sub4.5 隐藏行或列Rows("4:" & Q).Select '将第4行到第Q行隐藏Selection.EntireRow.Hidden = True隐藏列代码读者可自行尝试编制取消隐藏行Rows("4:" & Q).Select '取消第4行到第Q行隐藏Selection.EntireRow.Hidden = False取消隐藏列代码读者可自行尝试编制5复制并粘贴5.1 复制并选择性粘贴将工作表的C1：D4复制后选择性粘贴到工作表2的D1单元格Sheets(1).Range("C1:E4").Select 选择C1：C4 复制选中的单元格 Sheets(工作表名).Activate 激活名称为“工作表名的工作表 Sheets(2).Range("D1").Select 选中工作表2的单元格D1 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False5.2 复制并粘贴将工作表的C1：D4复制后选择性粘贴到工作表2的D1单元格Sheets(1).Range("C1:E4").Select Sheets(工作表名).Activate Sheets(2).Range("D1").Select 选中工作表2的D1单元格剪切并粘贴的代码读者请自行尝试编制。6循环语句6.1 Do While 循环Do While 是当条件不成立时停止循环，换言之就是条件为True时执行循环，直到条件为False时停止循环。假设A列数据是连续的，即没有从C1到最后一个单元格之间没有空格Sub 找到C列最后一个非空单元格的行数 ()H = 4Do While Not IsEmpty(Sheets(1).Cells(H, 3).Value)H = H + 1Loop6.2 Do Until循环 Do Until循环与Do Loop 循环相反，Do Until是当条件成立时停止循环，换言之就是条件为False时执行循环，直到条件为True时停止循环。这里就不再赘述了。6.3 For Next 循环给单元格A1到D4分别赋值1,2,3,416Sub 赋值()Dim i As Integer, j As Integer, n As Integern = 1For i = 1 To 4 For j = 1 To 4 Sheets("工作表名").Cells(i, j) = n n = n + 1 NextNextEnd Sub运行结果如下：7 if Then end if 语句在上面的例子中设定：假设i>3，就跳出代码，代码如下Sub 赋值()Dim i As Integer, j As Integer, n As Integern = 1For i = 1 To 4 If i > 3 Then Exit Sub End If For j = 1 To 4 Sheets("工作表名").Cells(i, j) = n n = n + 1 NextNextEnd Sub运行结果如下：8 With语句With 语句在一个单一对象或一个用户定义类型上执行一系列的语句。语法With objectstatementsEnd With举例如下：Sub 例子()With Sheets("工作表名称") .Cells(2, 3) = 4 .Range(C3) = 10End Sub从上面的例子可以看出在with结构中，可以将sheets("工作表名称").Cells(2, 3) = 4和sheets("工作表名称").Range(C3) = 10简写成.Cells(2, 3) = 4，.Range(C3) = 10，防止了重复代码的输入，可以提高代码速度。9去除单元格数据Sheets(“工作表名).Range("A3:E6").ClearComments '去除A3：E6单元格批注内容Sheets(“工作表名).Range("A3:E6").ClearContents '去除A3：E6单元格内容Sheets(“工作表名).Range("A3:E6").Clear 去除A3：E6所有内容、格式包括批注10 InputBox、MsgBox10.1 InputBox函数产生一个对话框，作为输入数据的界面，并返回所输入的内容。举例如下Sub 输入()Dim a As Integer a = Val(InputBox("请输入数字a") b = Val(InputBox("请输入数字b") Range("A1") = a + bEnd Sub运行结果如下：跳出第一个输入框，如下列图所示输入“3点击确定输入5并点击确定后得到结果A1=8，如下列图所示在这里你或许会问，如果运行代码后，只跳出一个窗口，在这个窗口中有两个输入框可以输入数据，分别输入3,5，然后点击确定，就得到结果：给单元格赋值8，那么怎么编制代码？这是完全可以实现的，请看本文第二局部第10条：窗体制作代码。10.2 MsgBox函数功能是弹出一个对话框。举例如下：Sub 欢送您()MsgBox "欢送您！"End Sub11 Sub函数与Fountion函数11.1函数结构Sub函数结构Sub 函数名()End SubFountion函数结构Fountion函数名()End Fountion11.2 Sub函数与Fountion函数1.function可以返回值，sub那么不可以返回值2.sub可以直接执行，但function需要调用才可以执行明白了这两点也就可以解决上面提到的矛盾了1.如果需要过程名function或sub的名字能返回值，那么必用function2.如果需要直接执行F5或链接到按钮控件，那么就要用sub了11.3Fountion函数举例例如1function 自定义函数，可以像普通公式一样在单元格中引用。用Function函数给单元格D1赋予公式=A1+B1-C1Function gs(a, b, c) gs = a + b - c '把公式的计算过程写到这里，输入公式时只要传入参数End Function在D1输入 =gs(A1,B1,C1) 例如2Public Function 程序()Select Case Range("g12") Case Is = "煤炭" MsgBox "本月已有数据，请从新选择！" Case Is ="土地" MsgBox "正确！"End SelectEnd Function这个函数可以再Sub函数中调用。12提高VBA代码运行速度的重要代码关闭代码运行过程中，屏幕自动刷新以提高代码运行速度的代码在代码的开头输入Application.ScreenUpdating = False '克服缓慢刷屏的毛病在代码的结尾输入Application.ScreenUpdating = True关闭excel中表格自动重新计算以提高代码运行速度的代码在代码的开头输入：Application.Calculation = xlManual '关闭系统对excel表格中公式的自动重新计算在代码的结尾输入：Application.Calculation = xlAutomatic使用With end with 结构可以省去很多重复代码，提高VBA代码运行速度。第二局部常用代码大全1添加自定义菜单代码Sub 在菜单中添加菜单项()Dim cbr As CommandBarDim cbp As CommandBarPopupOn Error Resume Next CommandBars("Worksheet menu bar").Controls("数据更新").Delete Set cbr = CommandBars("Worksheet Menu Bar")Set cbp = cbr.Controls.Add(msoControlPopup)With cbp .Caption = "数据更新" With .Controls.Add(msoControlButton) .Caption = "汇总工程" .OnAction = "improve1" End With With .Controls.Add(msoControlButton) .Caption = "数据更新" .OnAction = "improve2" End With With .Controls.Add(msoControlButton) .Caption = "更新节点表" .OnAction = "improve3" End With With .Controls.Add(msoControlButton) .Caption = "更新工程看板" .OnAction = "improve4" End With With .Controls.Add(msoControlButton) .Caption = "上市工程得分" .OnAction = "improve5" End With With .Controls.Add(msoControlButton) .Caption = "上市工程报表" .OnAction = "improve6" End WithEnd WithEnd SubSub improve1()End SubSub improve2()End SubSub improve3()End SubSub improve4()End SubSub improve5()End SubSub improve6()End Sub运行结果如下列图所示：2添加自定义工具栏代码Sub 在菜单中添加个人工具栏()Dim cbr As CommandBarDim cbn As CommandBarButtonOn Error Resume NextCommandBars("我的工具集").DeleteOn Error GoTo 0Set cbr = CommandBars.Add("我的工具集", msoBarFloating)With cbr Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "汇总工程" .Style = msoButtonCaption .OnAction = "improve1" End With Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "图数更新" .Style = msoButtonCaption .OnAction = "improve2" End With Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "节点表" .Style = msoButtonCaption .OnAction = "improve3" End With Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "工程看板" .Style = msoButtonCaption .OnAction = "improve4" End With Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "上市工程得分" .Style = msoButtonCaption .OnAction = "improve5" End With Set cbn = .Controls.Add(msoControlButton) With cbn .Caption = "上市工程报表" .Style = msoButtonCaption .OnAction = "improve6" End With cbr.Visible = TrueEnd WithEnd SubSub improve1()End SubSub improve2()End SubSub improve3()End SubSub improve4()End SubSub improve5()End SubSub improve6()End Sub运行结果如下列图所示：添加自定义工具栏的代码跟添加自定义菜单的代码实际上同出一辙4启开工作簿自动运行宏如果需要在翻开Excel工作簿时自动运行某个宏，可以用下面的两个方法： 4.1 Workbook.Open 事件 1.在Excel中按快捷键Alt+F11，翻开VBA编辑器。“工程窗口中双击“ThisWorkBook，在右侧的代码窗口顶部左侧的“对象框中，选择“WorkBook。这时，Excel自动在代码窗口中输入下面的代码： Private Sub Workbook_Open() End Sub 然后在其中输入需要执行的宏代码，如下例： Private Sub Workbook_Open() MsgBox ("Workbook_Open事件" & Chr(10) & ThisWorkbook.Name & "工作簿已翻开！") End Sub 3.保存工作簿并重新翻开该工作簿。如上例中将弹出一个消息框。用Auto_Open宏 1.在Excel中按快捷键Alt+F11，翻开VBA编辑器。“插入模块，在右侧的代码窗口中输入名称为“Auto_Open的宏，如下面的代码： Sub Auto_Open() MsgBox ("Auto_Open" & Chr(13) & "已翻开" & ThisWorkbook.Name & "工作簿！") End Sub 3.保存工作簿并重新翻开该工作簿。如上例中将弹出一个消息框。上述两种方法可以同时存在，但在翻开工作簿时按照先“Workbook_Open“后“Auto_Open的顺序执行。 5 VBA调用函数的方法如果sub函数名是变量将Sub函数作为一个元素装进数组里例如符合条件1就调用Sub函数A，符合条件2就调用Sub函数B，那么可以将函数名赋值给数组a=array(A,B)Sub 调用函数()myarray = Array(A, B)IF 条件1成立 ThenApplication.Run array(0) Array(0)表示数组的第一个元素，即Sub函数A，同理Array(1)表示第二个元素，即Sub函数BEnd sub如果直接调用sub函数，可以用CallSub 调用函数()Call 函数名End sub注明：Call可以省略6 sub 的递归任何一个过程都可以递归，所谓递归，就是过程调用其自身。看上去有点像死循环，但是在某些情况下也可以使用递归来完成任务。例如要在工作表忠一共创立6个工作表，如果工作表已经包含3个工作表，呢么再创立3个就够了；如果工作簿已经包含了2个工作表，那么还需要再创立4个，以此类推。此问题如用常规方法，代码如下：Sub 常规方法例如() Dim icount As Integer Worksheets.Add , Worksheets(Worksheets.Count), icountEnd Sub如用递归调用方法，代码如下：首先判断工作表总数是否等于6，如果等于6那么退出该过程。否那么在最后新建一个工作表，然后调用过程自身Sub 过程递归例如() If Worksheets.Count = 6 Then Exit Sub Worksheets.Add , Worksheets(Worksheets.Count) Call 过程递归例如End Sub7 userange函数找到数据边界返回工作表中数据区域的第一行，最后一行，第一列，最后一列。请注意，如果数据区域不是区域的，例如第一行第三行都有数据，而第二行没有数据，那么返回的最后一行将是3。如果第4行没有内容，但是第4行设置了格式，如涂了黄色或者设置了粗体字，那么返回的最后一行将是4。代码如下：Sub userange()Dim firstcol As Integer, lastcol As IntegerDim firstrow As Long, lastrow As LongMsgBox "数据区域最后一行是工作表中第" & lastrow + firstrow - 1 & "行,数据区域最后一列是工作表中第" & lastcol + fistcol - 1 & "列。"End Sub运行结果如下列图所示8 End (xldown) 和End(xlup)语句假设单元格A1包含数据，下面的代码引用A列中从单元格A1开始一直向下的最后一个包含数据的单元格。如果A1，A2有数据，而A3是空的，以下代码将引用A2。Range(“A1).End (xldown)相反的以下代码是从工作表最后一行向上，引用第1列中最后一个有数据的单元格Cells(Rows.Count,1) .End(xlup) 括号里的1表示第1列到此，你就会明白，同上文第6条一样，借用以上方法也能找到最后一行的行数，只不过有空单元格时结果会不一样9修改图表数据系列的引用数据Sheets(j).ChartObjects("Chart 6").Activate '这段代码修改快速通道工程状态各系列值的引用区域 ActiveChart.SeriesCollection(1).Name = "=" & sheet(1) & "!$AU$" & 1 设置数据系列1的名称为AU1单元格的内容 ActiveChart.SeriesCollection(1).Values = "=" & sheet1 & "!$AU$" & 2 & ":$AU$" & 10 设置数据系列1的引用数据位AU2：AU10，以下代码意思请类推。 ActiveChart.SeriesCollection(2).Name = "=" & sheet1 & "!$AW$" & 1 ActiveChart.SeriesCollection(2).Values = "=" & sheet1 & "!$AW$" &2 & ":$AW$" & 10 ActiveChart.SeriesCollection(3).Name = "=" & sheet1 & "!$AY$" & 1 ActiveChart.SeriesCollection(3).Values = "=" & sheet1 & "!$AY$" & 2 & ":$AY$" & 10 For bii = 1 To 3 ActiveChart.SeriesCollection(bii).XValues = "=" & sheet1 & "!$AP$" & 1 & ":$AP$" & 10 Next ActiveChart.SeriesCollection(4).Values = "=" & sheet1 & "!$BA$" & 2 & ":$BA$" & 10 ActiveChart.SeriesCollection(4).XValues = "=" & sheet1 & "!$AZ$" & 2 & ":$AZ$" & 10 ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = Sheets(sheet1).Cells(1, 37) - Sheets(sheet1).Cells(1, 31) '更新工程状态图的副纵坐标轴的最大值为Cells(1, 37)ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = 0 设置工程状态图的副纵坐标轴的最小值为010窗体制作代码首先按alt+F11翻开VBE窗口，插入窗体，从弹出的工具箱中选择标签如下列图中文字所在和文本框如下列图空的输入框所示，制作工作窗体如下列图所示。编制如下代码：Private Sub 确定_Click()Dim time1, time11, time2, time22, PAN As String'录入时间段 '消除上回窗体中的数据 输入第1个时间的年份.Value = "" 输入第1个时间的月份.Value = "" 输入第2个时间的年份.Value = "" 输入第2个时间的月份.Value = "" 输入是否删除已抓取工程.Value = ""在这里请把要执行的代码复制进来 Unload Me End Sub11翻开相应路径的工作表Sub 翻开关闭工作表()Dim str1, str2 As Stringt 当前工作表簿名称赋值给thisfilenamemypath = ThisWorkbook.Path & "" 当前工作簿的路径赋值给mypath objectfilename = Dir(mypath, 0) 这一句很神奇，依照路径依次返回要翻开工作簿的名称Do While Len(objectfilename) > 0 str1 = mypath & objectfilename 将工作簿的路径和名称连在一起，这样就能翻开指定工作簿 str2 = objectfilename If str1 <> mypath & thisfilename Then Workbooks.Open Filename:=str1 '指定翻开的工作簿 Workbooks(str2).Close savechanges:=True 保存并关闭工作簿 End If objectfilename = Dir()LoopEnd Sub12以B2：B10为主要关键字排序ActiveWorkbook.Worksheets(工作表 ActiveWorkbook.Worksheets(工作表名).Sort.SortFields.Add Key:=Range("B3:B10"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets(mystr2).Sort .SetRange Range("A2:AT10") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .ApplyEnd With 书近天辰如有疑问请加QQ503472867进行讨论。