1、1VBA 精粹摘录lLastRow = Sheets(“Database“).UsedRange.Rows.Count获取 Database 工作表中已使用区域的行数并赋值给变量 lLastRowRange(“B5:G65536“).Clear清除 B5:G65536 范围数据Sheets(“Database“).Range(“A1:F“ & lLastRow)使用变量 lLastRow 扩展数据列表lLastRow = Range(“A“ & Cells.Rows.Count).End(xlUp).Row获取 A 列最后一行行数Range(“E3:E“ & lLastRow).Formula
2、R1C1 = “=RC2*RC3*RC4“在 E 列计算范围内，按 R1C1 规则计算引用工作表的方法：Worksheets(“sheet1”).ActivateSheets(“sheet1”).ActivateWorkSheets 集合包含所有工作表。而 Sheets 集体不仅包含工作表集合 WorkSheets,还包含图表集合 Chats、宏表集合等。任何时刻工作簿中只有一个工作表是活动工作表。-设置加班费列的格式并突出显示最大值Sub SetFormat(rngF As Range)With rngF.NumberFormat = “0.00“.HorizontalAlignment =
3、 xlCenter.FormatConditions.Delete.FormatConditions.Add Type:=xlExpression, Formula1:=“=RC5=max(C5)“.FormatConditions(1).Interior.ColorIndex = 4End WithEnd Sub把二个比较数据置换位置方法：For i = 1 To n - 1 比较排序For j = i + 1 To nIf nSht(i) = 500End SubSub bjb()MsgBox Range(“B2“) Like “李*“End SubSub lja()MsgBox Rang
4、e(“C2“) = 60 Or Range(“D2“) = 60End Sub-If.Then 语句Option ExplicitSub SayZsh()If Time = 0.5 Then MsgBox “下午好!“End SubSub SayHello2()If Time 0.75 ThenMsgBox “晚上好!“Else8MsgBox “下午好!“End IfEnd Sub-Select Case 根据考核分评定职工星级Option ExplicitSub xingji()Dim xj As StringSelect Case Cells(2, “H“)Case Is 0.75MsgB
5、ox “晚上好!“Case ElseMsgBox “下午好!“End SelectEnd Sub-For.Next 语句Option ExplicitSub xingji()9Dim xj As String, i As IntegerFor i = 2 To 19 Step 1Select Case Cells(i, “H“)Case Is “Select Case Cells(i, “H“)Case Is 0.75 ThenMsgBox “晚上好!“ElseMsgBox “下午好!“End IfEnd SubSub RunSub_1()SayHelloEnd SubSub RunSub_2
6、()Call SayHelloEnd SubSub RunSub_3()Application.Run “SayHello“End Sub-过程的作用域Option ExplicitOption Private ModulePublic Sub gggc()MsgBox “我是公共过程！“End SubPrivate Sub sygc()MsgBox “我是私有过程！“End Sub-12试写一个函数Option ExplicitPublic Function Fun()Fun = Int(Rnd() * 10) + 1End FunctionSub msg()MsgBox Fun()End
7、Sub-怎么统计指定颜色的单元格个数Option ExplicitFunction Countcolor(arr As Range, c As Range)Dim rng As RangeFor Each rng In arrIf rng.Interior.Color = c.Interior.Color ThenCountcolor = Countcolor + 1End IfNext rngEnd Function-ScreenUpdating 属性Option ExplicitSub InputTest_1()Cells.ClearContents 清除表中所有数据Range(“A1:A
8、10“) = 100 在 A1:A10 单元格输入数值MsgBox “刚才在 A1：A10 输入数值 100，你能看到结果吗？ “ 显示提示框Range(“B1:B10“) = 200MsgBox “刚才在 B1：B10 输入数值 200，你能看到结果吗？“End SubSub InputTest_2()Cells.ClearContents 清除表中所有数据Application.ScreenUpdating = False 关闭屏幕更新Range(“A1:A10“) = 100 在 A1:A10 单元格输入数值MsgBox “刚才在 A1：A10 输入数值 100，你能看到结果吗？“ 显示
9、提示框Range(“B1:B10“) = 200MsgBox “刚才在 B1：B10 输入数值 200，你能看到结果吗？“Application.ScreenUpdating = True 恢复屏幕更新13End Sub-DisplayAlerts 属性（不显示计算结果到屏幕上）Option ExplicitSub DelSht_1()Dim sht As Worksheet 定义变量For Each sht In Worksheets 遍历所有工作表If sht.Name ActiveSheet.Name Then 判断 sht 代表的工作表是不是活动工作表sht.Delete 删除 sht
10、 代表的工作表End IfNextApplication.DisplayAlerts = True 恢复显示警告框End Sub-EanbleEvents 属性（自动写入单元格地址）Option ExplicitPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)Target.Value = Target.AddressEnd Sub-WorkSheetFunction 属性Option ExplicitSub CountTest_1()Dim mycount As Integer, rng As Range 定义变量For
11、Each rng In Range(“A1:B50“) 在 A1:B50 单元格里循环If rng.Value 1000 Then mycount = mycount + 1 如果满足条件，数量加 1NextMsgBox “A1:B50 中大于 1000 的单元格个数为：“ & mycount 提示框显示结果End SubSub CountTest_2()Dim mycount As Integer 定义变量mycount = Application.WorksheetFunction.CountIf(Range(“A1:B50“), “1000“)14MsgBox “A1:B50 中大于 1
12、000 的单元格个数为：“ & mycount 提示框显示结果End Sub-认识 Workbook，需要了解的信息Option ExplicitSub wb()Workbooks.Add 新建一个工作薄MsgBox “代码所在的工作簿为：“ & ThisWorkbook.Name 显示代码所在工作薄名称MsgBox “当前活动工作簿为：“ & ActiveWorkbook.Name 显示当前活动工作薄名称ActiveWorkbook.Close savechanges:=False 关闭新建工作薄，不保存修改End Sub-保存工作薄Option ExplicitSub SaveWb()Th
13、isWorkbook.Save 保存代码所在的工作薄End SubSub SaveToFile_1()ThisWorkbook.SaveAs Filename:=“D:test.Xls“ 另存为工作薄到 D 盘，文件名为：test.xlsEnd SubSub SaveToFile_2()ThisWorkbook.SaveCopyAs Filename:=“D:test.Xls“ 另存为工作薄到 D 盘，文件名为：test.xlsEnd Sub-打开工作薄Option ExplicitSub OpenFile()Workbooks.Open Filename:=“d:Book1.xls“ 打开
14、F 盘的 Book1.xlsEnd Sub-关闭工作薄Option ExplicitSub CloseWb_1()Workbooks.Close 关闭所有工作薄End Sub15Sub CloseWb_2()Workbooks(“Book1.xls“).CloseEnd SubSub CloseWb_3()Workbooks(“Book1“).Close savechanges:=True 关闭并保存修改End Sub-激活工作薄Option ExplicitSub JhWb()Workbooks(“Book1“).Activate 激活打开的名称为 Book1 的工作簿End Sub-Thi
15、sWorkbook 与 ActiveWorkbookOption ExplicitSub wb()Workbooks.Add 新建一个工作薄MsgBox “代码所在的工作簿为：“ & ThisWorkbook.Name 显示代码所在工作薄名称MsgBox “当前活动工作簿为：“ & ActiveWorkbook.Name 显示当前活动工作薄名称ActiveWorkbook.Close savechanges:=False 关闭新建工作薄，不保存修改End Sub-代码名称Sub ShowShtCode()MsgBox ActiveSheet.CodeNameEnd Sub-复制工作表Optio
16、n ExplicitSub shtcopy1()MsgBox “下面将把“工资表”复制到“出勤工作表”前!“Worksheets(“工资表“).Copy before:=Worksheets(“出勤登记表 “)End SubSub shtcopy2()MsgBox “下面将把“工资表”复制到“职工档案”后!“Worksheets(“工资表“).Copy after:=Worksheets(“职工档案“)End SubSub shtcopy3()16MsgBox “下面将把工资表复制到新工作薄中！“Worksheets(“工资表“).CopyEnd Sub-获取工作表的数目Option Expl
17、icitSub shtcount()Dim mycount% 定义变量mycount = Worksheets.Count 将结果保存在变量中MsgBox “工作簿里一共有 “ & mycount & “ 张工作表！“End Sub-移动工作表Option ExplicitSub shtmove()MsgBox “下面将把“工资表”移动到“出勤登记表”之前!“Worksheets(“工资表“).Move before:=Worksheets(“出勤登记表“)MsgBox “下面将把“工资表”移到到“职工档案”之后!“Worksheets(“工资表“).Move after:=Worksheet
18、s(“职工档案“)MsgBox “下面将把“工资表”移动到新工作薄中!“Worksheets(“工资表“).MoveEnd Sub-隐藏工作表Option ExplicitSub YcSht_1() Worksheets(“工资表“).Visible = False Worksheets(“工资表“).Visible = xlSheetHiddenWorksheets(“工资表“).Visible = 0End SubSub YcSht_2()Worksheets(“工资表“).Visible = xlSheetVeryHidden Worksheets(“工资表“).Visible = 2E
19、nd SubSub XsSht()Worksheets(“工资表“).Visible = TrueWorksheets(“工资表“).Visible = xlSheetVisibleWorksheets(“工资表“).Visible = 1Worksheets(“工资表“).Visible = -117End Sub-新建工作表Option ExplicitSub shtadd1()MsgBox “下面将在活动工作表前插入一张新工作表!“Worksheets.AddEnd SubSub shtadd2()MsgBox “下面将在第一张工作表前插入一张新工作表“Worksheets.Add be
20、fore:=Worksheets(1)End SubSub shtadd3()MsgBox “下面将在第一张工作表后插入一张新工作表“Worksheets.Add after:=Worksheets(1)End SubSub shtadd4()MsgBox “下面将在活动工作表前插入三张新工作表“Worksheets.Add Count:=3End SubSub shtadd5()MsgBox “下面将在第一张工作表后插入三张新工作表“Worksheets.Add after:=Worksheets(1), Count:=3End SubSub ShtAdd6()MsgBox “在第一张工作表
21、前插入一个名称为“工资表”的工作表“Worksheets.Add(before:=Worksheets(1).Name = “工资表“End Sub-Sheets 与 WorksheetsOption ExplicitSub test()MsgBox “Sheets(2).Name: “ & Sheets(2).NameMsgBox “Worksheets(2).Name: “ & Worksheets(2).NameMsgBox “Sheets.Count : “ & Sheets.CountMsgBox “Worksheets.Count: “ & Worksheets.CountEnd
22、Sub-多种方法引用 Range 对象CELLS 引用：Option ExplicitSub cel1()18MsgBox “下面将在在第 3 行与第 4 列的交叉单元格输入 20!“ActiveSheet.Cells(3, 4).Value = 20 在第 3 行与第 4 列的交叉单元格输入 20End SubSub cel2()MsgBox “下面将在在第 3 行与 D 列的交叉单元格输入 20!“ActiveSheet.Cells(3, “D“).Value = 20 在第 3 行与 D 列的交叉单元格输入 20End SubSub cel3()MsgBox “下面将在 B3：F9 区域
23、的第 2 行与第 3 列交叉单元格输入 100！“Range(“B3:F9“).Cells(2, 3) = 100End SubSub cel4()MsgBox “下面将在活动工作表的第 2 个单元格输入 200！“ActiveSheet.Cells(2).Value = 200 在活动工作表的第 2 个单元格输入 200End SubSub cel5()MsgBox “下面将在 B3:F9 区域的第 8 个单元格输入 100!“Range(“B3:F9“).Cells(8).Value = 100 在 B3:F9 的第 8 个单元格输入 100End SubSub cel6()MsgBox
24、“下面将在 B3:F9 区域的第 42 个单元格输入 100!“Range(“B3:F9“).Cells(42).Value = 100 在 B3:F9 的第 42 个单元格输入 100End SubSub cel7()Range 引用：Option ExplicitSub test1()Cells.ClearContentsMsgBox “下面将在 Sheet1 工作表的 A1 单元格输入 50!“Worksheets(“Sheet1“).Range(“A1“).Value = 50 在 Sheet1 工作表的 A1 单元格输入 50End SubSub rng()Cells.ClearCo
25、ntentsMsgBox “下面将在当前活动工作表的 A1：A10 输入数值 200!“Range(“A1:A10“).Value = 200MsgBox “下面将在当前活动工作表的 B1:B10 输入数值 100!“Dim n As String 定义变量19n = “B1:B10“Range(n) = 100 在当前活动工作表的 B1:B10 输入数值 100End SubSub rng2()Cells.ClearContentsMsgBox “下面将在 date 名称指代的区域输入数值 100!“Range(“date“).Value = 100End SubSub rng3()MsgB
26、ox “下面将选中多个单元格区域!“Range(“A1:A10,A4:E6,C3:D9“).Select 选中单元格区域End SubSub rng4()MsgBox “下面将选中两个单元格区域的交叉区域!“Range(“B1:B10 A4:D6“).SelectEnd SubSub rng5()MsgBox “下面将选中两个区域围成的矩形区域!“Range(“B6:B10“, “D2:D8“).SelectEnd Sub-更简单的引用方式：Option ExplicitSub evarng()MsgBox “下面将选中 B2 单元格!“B2.Select B2 单元格MsgBox “下面将选
27、中 A1:D10 单元格!“A1:D10.Select A1：D10 单元格MsgBox “下面将选中三个单元格区域!“A1:A10,C1:C10,E1:E10.Select 三个单元格区域的并集MsgBox “下面将选中两个区域的交叉区域!“B1:B10 A5:D5.Select 两个单元格区域的交集MsgBox “下面将选中名称 n 指代的单元格!“n.Select 定义名称为 n 的单元格区域End Sub-Application 对象的 Union 方法Option Explicit20Sub RngUnion()同时选中两个单元格区域Application.Union(Range(“
28、A1:A10“), Range(“D1:D5“).SelectEnd Sub-Range 对象的 Offset 属性Option ExplicitSub RngOffset()Range(“A1“).Offset(2, 3).Value = 500End SubSub RngOffset_1()Range(“C5:D6“).Offset(-3, 0).SelectEnd Sub-Range 对象的 Resize 属性Option ExplicitSub RngResize()Range(“B2“).Resize(5, 4).Select 将 B2 单元格扩展为 B2:E6 单元格End Sub
29、Sub RngResize_1()Range(“B2:E6“).Resize(2, 1).Select 将 B2:E6 单元格收缩为 B2:B3 单元格End Sub-UsedRange 属性Sub UsedRng()ActiveSheet.UsedRange.Select 选中活动工作表中已使用的单元格区域End Sub-UsedRange 属性Sub UsedRng()ActiveSheet.UsedRange.Select 选中活动工作表中已使用的单元格区域End Sub-Range 对象的 End 属性Option ExplicitSub RngEnd()Range(“C5“).End
30、(xlUp).SelectEnd SubSub RngEnd_1()ActiveSheet.Range(“A65536“).End(xlUp).Offset(1, 0).Value = “张青“21End Sub-Value 属性Option ExplicitSub RngValue()Range(“A1:B2“).Value = “abc“ 在 A1:B2 单元格输入 abcEnd SubSub RngValue_2()Range(“B1“).Value = Range(“A1“).Value 把 A1 单元格的内容写进 B1 单元格End SubSub RngValue_3()Range(
31、“A1:B2“) = “abc“ 在 A1：B2 单元格输入 abcEnd Sub-Count 属性Option ExplicitSub RngCount()Dim mycount As Integer 定义变量mycount = Range(“B4:F10“).Count 将结果赋给变量MsgBox “B4:F10 区域中一共有 “ & mycount & “ 个单元格！“End Sub-Address 属性Option ExplicitSub RngAddress()MsgBox “当前选中的单元格地址为：“ & Selection.AddressEnd Sub-选中单元格Option E
32、xplicitSub RngSelect()ActiveSheet.Range(“A1:B10“).SelectActiveSheet.Range(“A1:B10“).ActivateEnd Sub-删除单元格Option ExplicitSub RngDel()Range(“B5“).DeleteEnd Sub22-剪切单元格Option ExplicitSub RngCut()Range(“A1“).CurrentRegion.Cut Range(“G1“)End Sub-名称，Names 集合Option ExplicitSub NameAdd()Range(“A1:C10“).Name = “date“ 新建名称End SubSub UseName_1()ActiveWorkbook.Names(“date“).Name = “姓名“ 更改名称名ActiveWorkbook.Names(“姓名“).RefersTo = “张万平“ 更改名称的值End SubSub UseName_2()Dim i As Integer, mx As Integermx = ActiveWorkbook.Names.Count 统计名称的数量For i = 1 To mxActiveWorkbook.Names(i).Visible = Fa
