VBA学习笔记 - 思维导图

第01集：宏与VBA

1、鼠标放到过程代码位置，点击菜单中的运行

2、把代码写入按钮事件中

第02集：VBA中的语句、对象、方法与属性

1、VBA对象 VBA中的对象其实就是我们操作的具有方法、属性的excel中支持的对象 Excel中的几个常用对象表示方法

1、工作簿 ' Workbooks 代表工作簿集合，所有的工作簿,Workbooks(N)，表示已打开的第N个工作簿 ' Workbooks ("工作簿名称") ' ActiveWorkbook 正在操作的工作簿 ' ThisWorkBook '代码所在的工作簿

'2、工作表 ' 'Sheets("工作表名称") 'Sheet1 表示第一个插入的工作表,Sheet2表示第二个插入的工作表.... 'Sheets(n) 表示按排列顺序，第n个工作表 'ActiveSheet 表示活动工作表，光标所在工作表 'worksheet 也表示工作表，但不包括图表工作表、宏工作表等。

'3、单元格 'cells 所有单元格 'Range ("单元格地址") 'Cells(行数,列数) 'Activecell 正在选中或编辑的单元格 'Selection 正被选中或选取的单元格或单元格区域

方法属性

'一、VBA属性 'VBA属性就是VBA对象所具有的特点 '表示某个对象的属性的方法是 '对象.属性=属性值 Sub ttt() Range("a1").Value = 100 End Sub Sub ttt1() Sheets(1).Name = "工作表改名了" End Sub Sub ttt2() Sheets("Sheet2").Range("a1").Value = "abcd" End Sub Sub ttt3() Range("A2").Interior.ColorIndex = 3 End Sub

'二、VBA方法 'VBA方法是作用于VBA对象上的动作 '表示用某个方法作用于VBA的对象上，可以用下面的格式： Sub ttt4() '牛排.做熟的程度:=七成熟 Range("A1").Copy Range("A2") End Sub Sub ttt5() Sheet1.Move before:=Sheets("Sheet3") End Sub

语句 'VBA中的代码的基本结构与组成部分 'VBA语句

'一、宏程序语句 '运行后可以完成一个功能 Sub test() '开始语句 Range("a1") = 100 End Sub '结束语句

'二、函数程序语句 '运行后可以返回一个值 Function shcount() shcount = Sheets.Count End Function

'三、在程序中应用的语句 Sub test2() Call test End Sub Sub test3() For x = 1 To 100 'for next 循环语句 Cells(x, 1) = x Next x End Sub

第03集：循环语句

IF判断语句

Sub 判断1() '单条件判断 If Range("a1").Value > 0 Then Range("b1") = "正数" Else Range("b1") = "负数或0" End If End Sub

Sub 判断2() '多条件判断 If Range("a1").Value > 0 Then Range("b1") = "正数" ElseIf Range("a1") = 0 Then Range("b1") = "等于0" ElseIf Range("B1") <= 0 Then Range("b1") = "负数" End If End Sub

Sub 多条件判断2() If Range("a1") <> "" And Range("a2") <> "" Then Range("a3") = Range("a1") * Range("a2") End If End Sub

IIF函数判断

Sub 判断4() Range("a3") = IIf(Range("a1") <= 0, "负数或零", "负数") End Sub

select判断

Sub 判断1() '单条件判断 Select Case Range("a1").Value Case Is > 0 Range("b1") = "正数" Case Else Range("b1") = "负数或0" End Select End Sub

Sub 判断2() '多条件判断 Select Case Range("a1").Value Case Is > 0 Range("b1") = "正数" Case Is = 0 Range("b1") = "0" Case Else Range("b1") = "负数" End Select End Sub

Sub 判断3() If Range("a3") < "G" Then MsgBox "A-G" End If End Sub

判断范围

Sub if区间判断() If Range("a2") <= 1000 Then Range("b2") = 0.01 ElseIf Range("a2") <= 3000 Then Range("b2") = 0.03 ElseIf Range("a2") > 3000 Then Range("b2") = 0.05 End If End Sub

Sub select区间判断() Select Case Range("a2").Value Case 0 To 1000 Range("b2") = 0.01 Case 1001 To 3000 Range("b2") = 0.03 Case Is > 3000 Range("b2") = 0.05 End Select End Sub

第04集：判断语句

Sub t1() Range("d2") = Range("b2") * Range("c2") Range("d3") = Range("b3") * Range("c3") Range("d4") = Range("b4") * Range("c4") Range("d5") = Range("b5") * Range("c5") Range("d6") = Range("b6") * Range("c6") End Sub Sub t2() Dim x As Integer For x = 10000 To 2 Step -3 Range("d" & x) = Range("b" & x) * Range("c" & x) Next x End Sub Sub t3() Dim rg As Range For Each rg In Range("d2:d18") rg = rg.Offset(0, -1) * rg.Offset(0, -2) Next rg End Sub Sub t4() Dim x As Integer x = 1 Do x = x + 1 Cells(x, 4) = Cells(x, 2) * Cells(x, 3) Loop Until x = 18 End Sub Sub t5() x = 1 Do While x < 18 x = x + 1 Cells(x, 4) = Cells(x, 2) * Cells(x, 3) Loop End Sub

Sub s1() Dim rg As Range For Each rg In Range("a1:b7,d5:e9") If rg = "" Then rg = 0 End If Next rg End Sub Sub s2() Dim x As Integer Do x = x + 1 If Cells(x + 1, 1) <> Cells(x, 1) + 1 Then Cells(x, 2) = "断点" Exit Do End If Loop Until x = 14

第05集：VBA变量

'一、什么是变量？ '所谓变量，就是可变的量。就好象在内存中临时存放的一个小盒子，这个小盒子放的什么物体不固定。 Sub t1() Dim X As Integer 'x就是一个变量 For X = 1 To 10 Cells(X, 1) = X Next X End Sub

二、小盒子里可以放什么？ Dim m As Integer '变量

1 放数字 '如t1

'2 放文本 Sub t2() Dim st As String Dim X As Integer For X = 1 To 10 st = st & "Excel精英培训" Next X End Sub

3 放对象 Sub t3() Dim rg As Range Set rg = Range("a1") rg = 100 End Sub

4 放数组 Sub t4() Dim arr(1 To 10) As Integer, X As Integer For X = 1 To 10 arr(X) = X Next X End Sub

'三、变量的类型和声明

'1 变量的类型 '详见帮助文件 '2 为什么要声明变量 '3 声明变量 'dim public

'四、变量的存活周期

'1 过程级变量:过程结束，变量值释放 '如t1 '2 模块级变量:变量的值只在本模块中保持，工作簿关闭时随时释放 '例5 Sub t6() m = 1 End Sub Sub t5() MsgBox m m = 7 End Sub '3 全局级变量: 在所有的模块中都可以调用，值会保存到EXCEL关闭时才会被释放。 ' public 变量 Sub t7() MsgBox qq End Sub

'五变量的释放

一般情况下，过程级变量在过程运行结束后就会自动从内存中释放，而只有一些从外部借用的对象变量才需要使用set 变量=nothing进行释放。

六、变量声明

1、强制声明 Option Explicit

2、过程变量

3、公共变量 Public qq As Integer Sub DD() qq = 12 End Sub

第06集：函数与公式

一、在单元格中输入公式

1、用VBA在单元格中输入普通公式 Sub t1() Range("d2") = "=b2*c2" End Sub Sub t2() Dim x As Integer For x = 2 To 6 Cells(x, 4) = "=b" & x & "*c" & x Next x End Sub

2、用VBA在单元格输入带引号的公式 Sub t3() Range("c16") = "=SUMIF(A2:A6,""b"",B2:B6)" '遇到单引号就把单引号加倍 End Sub

3、用VBA在单元格中输入数组公式 Sub t4() Range("c9").FormulaArray = "=SUM(B2:B6*C2:C6)" End Sub、

二、利用单元格公式返回值

Sub t5() Range("d16") = Evaluate("=SUMIF(A2:A6,""b"",B2:B6)") Range("d9") = Evaluate("=SUM(B2:B6*C2:C6)") End Sub

三、借用工作表函数

Sub t6() Range("d8") = Application.WorksheeFunction.CountIf(Range("A1:A10"), "B") End Sub

四、利用VBA函数

Sub t7() Range("C20") = VBA.InStr(Range("a20"), "E") End Sub

'五、编写自定义函数

Function wn() wn = Application.Caller.Parent.Name End Function

第07集：VBE编辑器

一、VBE的窗口

1、工程窗口 'A 显示工作簿工作表对象 'B 窗体 'C 模块 'D 类模块 'range("a1")=10 '对应工程窗口的对象和模板，显示其所具体的一些特征。

3、代码窗口 'A 注释文字的设置 'B 代码缩进的设置 'C 代码强制转行的设置 'D 代码运行和调试 '逐句运行 '设置断点 'E 对象列表框和过程列表框

4、立即窗口 '立即窗口可以把运行过程中的值立即显示出来，主要用于程序的调试 Sub d() Dim x As Integer, st As String For x = 1 To 10 st = st & Cells(x, 1) Debug.Print "第" & x & "次运行结果:" & st Next x End Sub

5、本地窗口 '在本地窗口中可以显示运行中断时对象信息、变量值、数组信息等。 Sub d1() Dim x As Integer, k As Integer For x = 1 To 10 k = k + Cells(x, 1) Next x End Sub

子主题

第08集：VBA分支与End语句

第09集：excel文件操作

文件概念

'excel文件和工作簿 'excel文件就是excel工作簿，excel文件打开需要excel程的支持 'Workbooks 工作簿集合，泛指excel文件或工作簿 'Workbooks("A.xls")，名称为A的excel工作簿 Sub t1() Workbooks("A.xls").Sheets(1).Range("a1") = 100 End Sub 'workbooks(2)，按打开顺序，第二个打开的工作簿。 Sub t2() Workbooks(2).Sheets(2).Range("a1") = 200 End Sub 'ActiveWorkbook ，当打开多个excel工作簿时，你正在操作的那个就是ActiveWorkbook（活动工作簿） 'Thisworkbook，VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿。

'工作簿窗口 'Windows("A.xls"),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。 Sub t3() Windows("A.xls").Visible = False End Sub Sub t4() Windows(2).Visible = True End Sub

文件操作

'1 判断A.Xls文件是否存在

Sub W1() If Len(Dir("d:/A.xls")) = 0 Then MsgBox "A文件不存在" Else MsgBox "A文件存在" End If End Sub

'2 判断A.Xls文件是否打开

Sub W2() Dim X As Integer For X = 1 To Windows.Count If Windows(X).Caption = "A.XLS" Then MsgBox "A文件打开了" Exit Sub End If Next End Sub

'3 excel文件新建和保存

Sub W3() Dim wb As Workbook Set wb = Workbooks.Add wb.Sheets("sheet1").Range("a1") = "abcd" wb.SaveAs "D:/B.xls" End Sub

'4 excel文件打开和关闭

Sub w4() Dim wb As Workbook Set wb = Workbooks.Open("D:/B.xls") MsgBox wb.Sheets("sheet1").Range("a1").Value wb.Close False End Sub

'5 excel文件保存和备份

Sub w5() Dim wb As Workbook Set wb = ThisWorkbook wb.Save wb.SaveCopyAs "D:/ABC.xls" End Sub

'6 excel文件复制和删除

Sub W6() FileCopy "D:/ABC.XLS", "E:/ABCd.XLS" Kill "D:/ABC.XLS" End Sub

第10集：excel工作表操作

工作表概念

excel工作表的分类 'excel工作表有两大类，一类是我们平常用的工作表(worksheet)，另一类是图表、宏表等。这两类的统称是sheets 'sheets 工作表集合，泛指excel各种工作表 'Sheets("A")，名称为A的excel工作表 Sub t1() Sheets("A").Range("a1") = 100 End Sub 'workbooks(2)，按打开顺序，第二个打开的工作簿。 Sub t2() Sheets(2).Range("a1") = 200 End Sub 'ActiveSheet ，当打开多个excel工作簿时，你正在操作的那个就是ActiveSheet

工作表操作

'1 判断A工作表文件是否存在

Sub s1() Dim X As Integer For X = 1 To Sheets.Count If Sheets(X).Name = "A" Then MsgBox "A工作表存在" Exit Sub End If Next MsgBox "A工作表不存在" End Sub

'2 excel工作表的插入

Sub s2() Dim sh As Worksheet Set sh = Sheets.Add sh.Name = "模板" sh.Range("a1") = 100 End Sub

'3 excel工作表隐藏和取消隐藏

Sub s3() Sheets(2).Visible = True End Sub

'4 excel工作表的移动

Sub s4() Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面 Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面 End Sub

'6 excel工作表的复制

Sub s5() '在本工作簿中 Dim sh As Worksheet Sheets("模板").Copy before:=Sheets(1) Set sh = ActiveSheet sh.Name = "1日" sh.Range("a1") = "测试" End Sub

Sub s6() '另存为新工作簿 Dim wb As Workbook Sheets("模板").Copy Set wb = ActiveWorkbook wb.SaveAs ThisWorkbook.Path & "/1日.xls" wb.Sheets(1).Range("b1") = "测试" wb.Close True End Sub

'7 保护工作表

Sub s7() Sheets("sheet2").Protect "123" End Sub Sub s8() '判断工作表是否添加了保护密码 If Sheets("sheet2").ProtectContents = True Then MsgBox "工作簿保护了" Else MsgBox "工作簿没有添加保护" End If End Sub

'8 工作表删除

Sub s9() Application.DisplayAlerts = False Sheets("模板").Delete Application.DisplayAlerts = True End Sub

'9 工作表的选取

Sub s10() Sheets("sheet2").Select End Sub

第11集：单元格选取

'1 表示一个单元格(a1)

Sub s() Range("a1").Select Cells(1, 1).Select Range("A" & 1).Select Cells(1, "A").Select Cells(1).Select [a1].Select End Sub

'2 表示相邻单元格区域

Sub d() '选取单元格a1:c5 'Range("a1:c5").Select ' Range("A1", "C5").Select 'Range(Cells(1, 1), Cells(5, 3)).Select 'Range("a1:a10").Offset(0, 1).Select Range("a1").Resize(5, 3).Select End Sub

'3 表示不相邻的单元格区域

Sub d1() Range("a1,c1:f4,a7").Select 'Union(Range("a1"), Range("c1:f4"), Range("a7")).Select End Sub Sub dd() 'union示例 Dim rg As Range, x As Integer For x = 2 To 10 Step 2 If x = 2 Then Set rg = Cells(x, 1) Set rg = Union(rg, Cells(x, 1)) Next x rg.Select End Sub

'4 表示行

Sub h() 'Rows(1).Select 'Rows("3:7").Select 'Range("1:2,4:5").Select Range("c4:f5").EntireRow.Select End Sub

'5 表示列

Sub L() ' Columns(1).Select ' Columns("A:B").Select ' Range("A:B,D:E").Select Range("c4:f5").EntireColumn.Select '选取c4:f5所在的行 End Sub

'6 重置坐标下的单元格表示方法

Sub cc() Range("b2").Range("a1") = 100 End Sub

'7 表示正在选取的单元格区域

Sub d2() Selection.Value = 100 End Sub

第12集：特殊单元格定位

'1 已使用的单元格区域

Sub d1() Sheets("sheet2").UsedRange.Select 'wb.Sheets(1).Range("a1:a10").Copy Range("i1") End Sub

'2 某单元格所在的单元格区域

Sub d2() Range("b8").CurrentRegion.Select End Sub

'3 两个单元格区域共同的区域

Sub d3() Intersect(Columns("b:c"), Rows("3:5")).Select End Sub

'4 调用定位条件选取特殊单元格

Sub d4() Range("A1:A6").SpecialCells(xlCellTypeBlanks).Select End Sub

'5 端点单元格

Sub d5() Range("a65536").End(xlUp).Offset(1, 0) = 1000 End Sub Sub d6() Range(Range("b6"), Range("b6").End(xlToRight)).Select End Sub

第13集：单元格信息

'1 单元格的值

Sub x1() Range("b10") = Range("c2").Value Range("b11") = Range("c2").Text Range("c10") = "'" & Range("I3").Formula End Sub

'2 单元格的地址

Sub x2() With Range("b2").CurrentRegion [b12] = .Address [c12] = .Address(0, 0) [d12] = .Address(1, 0) [e12] = .Address(0, 1) [f12] = .Address(1, 1) End With End Sub

'3 单元格的行列信息

Sub x3() With Range("b2").CurrentRegion [b13] = .Row [b14] = .Rows.Count [b15] = .Column [b16] = .Columns.Count [b17] = .Range("a1").Address End With End Sub

'4、单元格的格式信息

Sub x4() With Range("b2") [b19] = .Font.Size [b20] = .Font.ColorIndex [b21] = .Interior.ColorIndex [b22] = .Borders.LineStyle End With End Sub

'5、单元格批注信息

Sub x5() [B24] = Range("I2").Comment.Text End Sub

'6 单元格的位置信息

Sub x6() With Range("b3") [b26] = .Top [b27] = .Left [b28] = .Height [b29] = .Width End With End Sub

'7 单元格的上级信息

Sub x7() With Range("b3") [b31] = .Parent.Name [b32] = .Parent.Parent.Name End With End Sub

'8 内容判断

Sub x8() With Range("i3") [b34] = .HasFormula [b35] = .Hyperlinks.Count End With End Sub

'9 单元格数据类型（另讲）

第14集：单元格的格式

单元格颜色

'Excel中的颜色可以用两种方式获取，一种是EXCEL内置颜色，另一种是利用QBCOLOR函数返回 Sub y1() Dim x As Integer Range("a1:b60").Clear For x = 1 To 56 Range("a" & x) = x Range("b" & x).Font.ColorIndex = 3 Next x End Sub Sub y2() Dim x As Integer For x = 0 To 15 Range("d" & x + 1) = x Range("e" & x + 1).Interior.Color = QBColor(x) Next x End Sub Sub y3() Dim 红 As Integer, 绿 As Integer, 蓝 As Integer 红 = 255 绿 = 123 蓝 = 100 Range("g1").Interior.Color = RGB(红, 绿, 蓝) End Sub

数据格式

'一、判断数值的格式

'1 判断是否为空单元格 Sub d1() [b1] = "" 'If Range("a1") = "" Then 'If Len([a1]) = 0 Then If VBA.IsEmpty([a1]) Then [b1] = "空值" End If End Sub

'2 判断是否为数字 Sub d2() [b2] = "" 'If VBA.IsNumeric([a2]) And [a2] <> "" Then 'If Application.WorksheetFunction.IsNumber([a2]) Then [b2] = "数字" End If End Sub

'3 判断是否为文本 Sub d3() [b3] = "" 'If Application.WorksheetFunction.IsText([A3]) Then If VBA.TypeName([a3].Value) = "String" Then [b3] = "文本" End If End Sub

'4 判断是否为汉字 Sub d4() [b4] = "" If [a4] > "z" Then [b4] = "汉字" End If End Sub

'5 判断错误值 Sub d10() [b5] = "" 'If VBA.IsError([a5]) Then If Application.WorksheetFunction.IsError([a5]) Then [b5] = "错误值" End If End Sub Sub d11() [b6] = "" If VBA.IsDate([a6]) Then [b6] = "日期" End If End Sub

'二、设置单元格自定义格式

Sub d30() Range("d1:d8").NumberFormatLocal = "0.00" End Sub

'三、按指定格式从单元格返回数值

'Format函数语法(和工作表数Text用法基本一致) 'Format(数值,自定义格式代码)

单元格合并

Sub h1() Range("g1:h3").Merge End Sub

'合并区域的返回信息

Sub h2() Range("e1") = Range("b3").MergeArea.Address '返回单元格所在的合并单元格区域 End Sub

'判断是否含合并单元格

Sub h3() 'MsgBox Range("b2").MergeCells ' MsgBox Range("A1:D7").MergeCells Range("e2") = IsNull(Range("a1:d7").MergeCells) Range("e3") = IsNull(Range("a9:d72").MergeCells) End Sub

'综合示例 '合并H列相同单元格

Sub h4() Dim x As Integer Dim rg As Range Set rg = Range("h1") Application.DisplayAlerts = False For x = 1 To 13 If Range("h" & x + 1) = Range("h" & x) Then Set rg = Union(rg, Range("h" & x + 1)) Else rg.Merge Set rg = Range("h" & x + 1) End If Next x Application.DisplayAlerts = True End Sub

第15集：单元格编辑示例

单元格输入

'1 单元格输入

Sub t1() Range("a1") = "a" & "b" Range("b1") = "a" & Chr(10) & "b" '换行答输入 End Sub

'2 单元格复制和剪切

Sub t2() Range("a1:a10").Copy Range("c1") 'A1：A10的内容复制到C1 End Sub Sub t3() Range("a1:a10").Copy ActiveSheet.Paste Range("d1") '粘贴至D1 End Sub Sub t4() Range("a1:a10").Copy Range("e1").PasteSpecial (xlPasteValues) '只粘贴为数值 End Sub Sub t5() Range("a1:a10").Cut ActiveSheet.Paste Range("f1") '粘贴到f1 End Sub Sub t6() Range("c1:c10").Copy Range("a1:a10").PasteSpecial Operation:=xlAdd '选择粘贴-加 End Sub Sub T7() Range("G1:G10") = Range("A1:A10").Value End Sub

'3 填充公式

Sub T8() Range("b1") = "=a1*10" Range("b1:b10").FillDown '向下填充公式 End Sub

单元格行表的删除和插入

插入行

Sub c1() Rows(4).Insert End Sub

插入行并向下填充公式

Sub c2() '插入行并复制公式 Rows(4).Insert Range("3:4").FillDown Range("4:4").SpecialCells(xlCellTypeConstants) = "" End Sub

子主题

Sub c3() Dim x As Integer For x = 2 To 20 If Cells(x, 3) <> Cells(x + 1, 3) Then Rows(x + 1).Insert x = x + 1 End If Next x End Sub

分类汇总方法

Sub c4() Dim x As Integer, m1 As Integer, m2 As Integer Dim k As Integer m1 = 2 For x = 2 To 1000 If Cells(x, 1) = "" Then Exit Sub If Cells(x, 3) <> Cells(x + 1, 3) Then m2 = x Rows(x + 1).Insert Cells(x + 1, "c") = Cells(x, "c") & " 小计" Cells(x + 1, "h") = "=sum(h" & m1 & ":h" & m2 & ")" Cells(x + 1, "h").Resize(1, 4).FillRight Cells(x + 1, "i") = "" x = x + 1 m1 = m2 + 2 End If Next x End Sub

子主题

Sub c44() '个人方法 Dim x As Integer Dim t As Integer t = Range("c65536").End(xlUp).Row For x = t To 2 Step -1 If Cells(x, 3) <> Cells(x - 1, 3) Then Rows(x).Insert Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row + 1, "C") = Cells(Cells(x, "C").Offset(1, 0).End(xlDown).Row, "C") & " 小计" Cells(Cells(x, "H").Offset(1, 0).End(xlDown).Row + 1, "H") = _ Application.Sum(Range(Cells(x, "h").Offset(1, 0), Cells(x, "H").Offset(1, 0).End(xlDown))) End If Next x End Sub

删除空值所在的行

Sub dd() '删除小计行 Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End Sub

第16集：单元格查找

子主题

'1 使用循环查找 (在单元格中查找效率太低)

'2 调用工作表函数

Sub c1() '判断是否存在,并查找所在行数 Dim hao As Integer Dim icount As Integer icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3]) If icount > 0 Then MsgBox "该入库单号码已经存在，请不要重复录入" MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0) End If End Sub

'3 使用Find方法

Sub c2() Dim r As Integer, r1 As Integer Dim icount As Integer icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3]) If icount > 0 Then r = Sheets("库存明细表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row '查找号码第一次出现的位置 r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).Row MsgBox r & ":" & r1 End If End Sub

4、向下查找非空行的行数

Sub c3() '返回最下一行非空行的行数 MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).Row End Sub

入库单实例

输入

Sub 输入() Dim c As Integer '号码在库存表中的个数 Dim r As Integer '入库单的数据行数 Dim cr As Integer '库存明细表中第一个空行的行数 With Sheets("库存明细表") c = Application.CountIf(.[b:b], Range("g3")) If c > 0 Then MsgBox "该单据号码已经存在！,请不要重复录入" Exit Sub Else r = Application.CountIf(Range("b6:b10"), "<>") cr = .[b65536].End(xlUp).Row + 1 .Cells(cr, 1).Resize(r, 1) = Range("e3") .Cells(cr, 2).Resize(r, 1) = Range("g3") .Cells(cr, 3).Resize(r, 1) = Range("c3") .Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value MsgBox "输入已完成" End If End With End Sub

查找

Sub 查找() Dim c As Integer '号码在库存表中的个数 Dim r As Integer '入库单的数据行数 With Sheets("库存明细表") c = Application.CountIf(.[b:b], Range("g3")) If c = 0 Then MsgBox "该单据号码不存在！" Exit Sub Else r = .[b:b].Find(Range("g3"), , , , , xlNext).Row Range("c3") = .Cells(r, 3) Range("e3") = .Cells(r, 1) Cells(6, 2).Resize(c, 5) = .Cells(r, 4).Resize(c, 5).Value MsgBox "查询已完成" End If End With End Sub

删除

Sub 删除() Dim c As Integer '号码在库存表中的个数 Dim r As Integer '入库单的数据行数 With Sheets("库存明细表") c = Application.CountIf(.[b:b], Range("g3")) If c = 0 Then MsgBox "该单据号码不存在！" Exit Sub Else r = .[b:b].Find(Range("g3"), , , , , xlNext).Row .Range(r & ":" & c + r - 1).Delete MsgBox "删除已完成" End If End With End Sub

修改

Sub 修改() Call 删除 Call 输入 End Sub

第17集：Excel工作表事件程序(上)

WorkSheetS对象（事件）

Activate

Private Sub Worksheet_Activate() End Sub

BeforeDelete

Private Sub Worksheet_BeforeDelete() End Sub

BeforeDoubleClick

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) End Sub

BeforeRightClick

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) End Sub

Calculate

Private Sub Worksheet_Calculate() End Sub

Change

Private Sub Worksheet_Change(ByVal Target As Range) End Sub

Deactivate

Private Sub Worksheet_Deactivate() End Sub

FollowHyperlink

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) End Sub

LensGalleryRenderComplete

Private Sub Worksheet_LensGalleryRenderComplete() End Sub

PivotTableAfterValueChange

Private Sub Worksheet_PivotTableAfterValueChange(ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range) End Sub

PivotTableBeforeAllocateChanges

Private Sub Worksheet_PivotTableBeforeAllocateChanges(ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean) End Sub

PivotTableBeforeCommitChanges

Private Sub Worksheet_PivotTableBeforeCommitChanges(ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean) End Sub

PivotTableBeforeDiscardChanges

Private Sub Worksheet_PivotTableBeforeDiscardChanges(ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long) End Sub

PivotTableChangeSync

Private Sub Worksheet_PivotTableChangeSync(ByVal Target As PivotTable) End Sub

PivotTableUpdate

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable) End Sub

SelectionChange

Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub

TableUpdate

Private Sub Worksheet_TableUpdate(ByVal Target As TableObject) End Sub

第18集：Excel工作簿事件

WorkBook对象（事件）

Activate

Private Sub Workbook_Activate() End Sub

AddinInstall

Private Sub Workbook_AddinInstall() End Sub

AddinUninstall

Private Sub Workbook_AddinUninstall() End Sub

AfterSave

Private Sub Workbook_AfterSave(ByVal Success As Boolean) End Sub

AfterXmlExport

Private Sub Workbook_AfterXmlExport(ByVal Map As XmlMap, ByVal Url As String, ByVal Result As XlXmlExportResult) End Sub

AfterXmlImport

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, ByVal Result As XlXmlImportResult) End Sub

BeforeClose

Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub

BeforePrint

Private Sub Workbook_BeforePrint(Cancel As Boolean) End Sub

BeforeSave

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) End Sub

BeforeXmlExport

Private Sub Workbook_BeforeXmlExport(ByVal Map As XmlMap, ByVal Url As String, Cancel As Boolean) End Sub

BeforeXmlImport

Private Sub Workbook_BeforeXmlImport(ByVal Map As XmlMap, ByVal Url As String, ByVal IsRefresh As Boolean, Cancel As Boolean) End Sub

Deactivate

Private Sub Workbook_Deactivate() End Sub

ModelChange

Private Sub Workbook_ModelChange(ByVal Changes As ModelChanges) End Sub

NewChart

Private Sub Workbook_NewChart(ByVal Ch As Chart) End Sub

NewSheet

Private Sub Workbook_NewSheet(ByVal Sh As Object) End Sub

Open

Private Sub Workbook_Open() End Sub

PivotTableCloseConnection

Private Sub Workbook_PivotTableCloseConnection(ByVal Target As PivotTable) End Sub

PivotTableOpenConnection

Private Sub Workbook_PivotTableOpenConnection(ByVal Target As PivotTable) End Sub

RowsetComplete

Private Sub Workbook_RowsetComplete(ByVal Description As String, ByVal Sheet As String, ByVal Success As Boolean) End Sub

SheetActivate

Private Sub Workbook_SheetActivate(ByVal Sh As Object) End Sub

SheetBeforeDelete

Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object) End Sub

SheetBeforeDoubleClick

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) End Sub

SheetBeforeRightClick

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) End Sub

SheetCalculate

Private Sub Workbook_SheetCalculate(ByVal Sh As Object) End Sub

SheetChange

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) End Sub

SheetDeactivate

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) End Sub

SheetFollowHyperlink

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) End Sub

SheetLensGalleryRenderComplete

Private Sub Workbook_SheetLensGalleryRenderComplete(ByVal Sh As Object) End Sub

SheetPivotTableAfterValueChange

Private Sub Workbook_SheetPivotTableAfterValueChange(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal TargetRange As Range) End Sub

SheetPivotTableBeforeAllocateChanges

Private Sub Workbook_SheetPivotTableBeforeAllocateChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean) End Sub

SheetPivotTableBeforeCommitChanges

Private Sub Workbook_SheetPivotTableBeforeCommitChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long, Cancel As Boolean) End Sub

SheetPivotTableBeforeDiscardChanges

Private Sub Workbook_SheetPivotTableBeforeDiscardChanges(ByVal Sh As Object, ByVal TargetPivotTable As PivotTable, ByVal ValueChangeStart As Long, ByVal ValueChangeEnd As Long) End Sub

SheetPivotTableChangeSync

Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable) End Sub

SheetPivotTableUpdate

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable) End Sub

SheetSelectionChange

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) End Sub

SheetTableUpdate

Private Sub Workbook_SheetTableUpdate(ByVal Sh As Object, ByVal Target As TableObject) End Sub

Sync

Private Sub Workbook_Sync(ByVal SyncEventType As Office.MsoSyncEventType) End Sub

WindowActivate

Private Sub Workbook_WindowActivate(ByVal Wn As Window) End Sub

WindowDeactivate

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window) End Sub

WindowResize

Private Sub Workbook_WindowResize(ByVal Wn As Window) End Sub

第19集：excel程序事件

子主题

Public WithEvents app As Excel.Application

第20集：VBA数组-1：数组基础

第21集：BA数组-2读取

第22集：数组-3

第23集：数组-4：数组与函数

第24集：VBA数组-5：数组与单元格格式

第25集：VBA8025集VBA数组之VBA排序算法(上)

第26集：VBA数组-7：VBA排序算法之插入排序和希尔排序

第27集：VBA字典-1

第28集：VBA字典-2

第29集：VBA数组与字典综合应用之下棋法（兰色原创）

第30集：自定义函数基础

第31集：自定义函数的参数设置

第32集：Msgbox函数完全应用

第33集：Inputbox函数方法应用

第34集：调用Excel对话框

第35集：字符串的拆分、查找与转换

第36集：like运算符的使用

第37集：正则表达式1

第38集：正则表达式2

第39集：正则表达式3

第40集：正则表达式4

第41集：正则表达式5

第42集：数据类型转换

第43集：时间与日期

第44集：图片与图形处理

第45集：随机抽取之移形换位法

第46集：组合之递归算法

第47集：VBA程序提速

第48集：基本操作

第49集：文件夹遍历

第50集：VBA压缩文件和解压缩

第51集：Txt文件的写入

第52集：Txt文件的读取

第53集：窗体与控件基础

第54集：窗体事件

第55集：标签、按钮

第56集：文字框

第57集：列表和组合框

第58集：单选复选和框架和多页

第59集：Listview控件

第60集：treeview控件

第61集：日期和进度条

第62集：窗体综合实例

第63集：命令栏操作之命令栏

第64集：命令栏操作之自定义命令

第65集：功能区(Ribbon)的操作一（07或10版）

第66集：功能区(Ribbon)的操作二（07或10版）

第67集：代码操作代码

第68集：类模块入门

第69集：类模块事件

第70集：类的封装

第71集：数据库的基本操作

第72集：SQL语言基础

第73集：SQL高级查询技术

第74集：SLQ+ADO综合实例

第75集：SQL实例之进销存报表生成

第76集：网络数据下载与邮件发送

第77集：API基础

第78集：API函数实例应用

第79集：VBA代码的封装

第80集：COM加载宏