第1节：初始 系统设置
'关闭屏幕更新 【作用：去除不必要闪屏】Excel.Application.ScreenUpdating = False
'关闭屏幕提示：删除提示等【作用：因涉及多个提示框操作，必须开启，导致程序暂停】Excel.Application.DisplayAlerts = False
-------此处忽略10万行代码-------
'重启屏幕提示：删除提示等Excel.Application.DisplayAlerts = True
'重启屏幕更新Excel.Application.ScreenUpdating = True
第2节：定义变量
Dim 变量名 as 数据类型：例 Dim i As Integer
Const 常量名 as 数据类型：例 Const p As Single = 3.14
Range("B"& i )
Cells 什么时候使用？牵扯到行和列都要循环的时候，建议使用Cells。
第3节：条件判断及循环体
1、IF条件判断
If 条件表达式 Then
表达式返回True时要执行的代码
ElseIf 条件表达式 Then
表达式返回True时要执行的代码
Else
表达式返回Flase时要执行的代码
End If
2、For循环语句
For 循环变量=初值 To 终值 【step 步长值】【删除行的时候，使用负数】
循环体
Exit for
循环体
Next
3、Do While ... Loop 循环
Do While 条件表达式
表达式返回True时要执行的代码
-------此处忽略10万行代码-------
j=j+1 【正常情况下，会有一个变量作为参数】
Loop
4、For Each ...In ... 循环
For Each 变量或对象 In 数组
要执行的代码
Next
第4节：工作表
1、对象 对象说明
Application Excel应用程序
Workbook 工作薄
WorkSheet 工作表
Range 单元格
2、选择工作表
Sheets("指定工作表名").Select 选中表格
Sheets("指定工作表名").name="数据少年" 重命名
3、新建工作表
Sheets.Add before:=Sheets("sheet1") 在sheet1前面加一张工作表
Sheets.Add after:=Sheets("sheet1") 在sheet1后面加一张工作表
Sheets.Add before:=Sheets("sheet1"), Count:=3 在sheet1前面加3张工作表
Sheets.Add after:=Sheets(Sheets.count) 在最后一张工作表后面插入工作表，先计算文件中有几张工作表
第5节：对象
Set 变量名称 = 要存储的对象名称
Dim sht As Worksheet 定义一个工作表对象
Set sht= ActiveSheet 将活动工作表赋给变量sht
MsgBox 对话框显示结果值，调试必备
Call 函数
调用方法，可以将方法分开步骤，再进行调用。
Sub 合并()
Call 总分
Call 汇总
End Sub
第6节：函数
1、随机数
Excel随机数函数：Randbetween(1,100) 表示1-100的内的随机数
Funtion 随机数() '无参函数
随机数=Int(Rnd()*10)+1
End Funtion
2、有参函数
Funtion 计算器(x)
y=x+1 '则返回y的值
End Funtion
3、自定义函数
定义函数：f(x)=x+12
调用函数：y=f(x)=f(2)=2+12=14
4、常用函数
Len(x) ：获取字符长度
Trim(x)：去除头尾空格
Replace(x,y,z)：x 代表字符串本身，y代表被替换的字符，z代表结果字符
UCase(x)：大写转换
LCase(x)：小写转换
Left(x,y)：x 代表字符串本身，y代表 数字，要截取的字符串长度，方向从左边截取
Right(x,y)：x 代表字符串本身，y代表 数字，要截取的字符串长度，方向从右边截取
Mid(x,y,z)：x 代表字符串本身，y代表 数字 从第几位开始截取，z代表 数字，要截取的字符串长度，方向从左边截取
InStr(x,y)：x 代表字符串本身，y代表 要查找的字符，如果不存在则返回0，如果存在则返回第一个查找到的位置。
案例：
Sub text()
Dim s
Set s = Range("A2")
城市 = InStr(s, "市")
区县 = InStr(s, "区")
Range("E2") = Left(s, 城市)
Range("F2") = Mid(s, 城市 + 1, 区县 - 城市)
Range("G2") = Right(s, Len(s) - 区县)
End Sub
Split(x,y)(z)：x 代表字符串本身，y代表 分割的字符，z代表从零开始数组
DateSerial(x,y,z)：x 代表：字符串年，y代表：字符串月，z代表：字符串日
第7节：循环遍历
1、For Each ...In ... 循环
For Each 变量或对象 In 数组
要执行的代码
Next
2、WorkSheets 工作表
For Each K In WorkSheets '相当于： For i to Sheets.count Set w=Sheets(i)
Range("A2")=K.name
Next
第8节：工作薄
1、Workbook：代表一个工作薄
Workbooks :代表 当前打开的所有工作薄
2、正确引用工作簿：
Workbooks("x") : x代表 工作薄的名称
Workbooks("x") .Activate 激活工作薄
ActivateWorkbook 是对活动工作薄的引用
3、ThisWorkbook 是代码所在的工作薄对象
ThisWorkbook.Name 获取工作薄名称
ThisWorkbook.Path 获取工作薄文件所在路径
ThisWorkbook.FullName 获取带路径的工作薄名称
4、工作薄创建、打开、关闭
Workbooks.Add 新建一张空白工作薄
Workbooks.Add “C：\User\Desktop\测试.xlsx” 根据指定文件，创建一张一模一样的工作薄，类似于复制
Workbooks.Open “C：\User\Desktop\测试.xlsx” 根据指定文件，打开文件
Workbooks.Close 关闭当前打开的所有工作薄
Workbooks("x").Close 关闭当前打开的x工作薄
Workbooks("x").Close True 保存关闭
Workbooks("x").Close False 不保存关闭
5、工作薄保存及关闭
ThisWorkbook.Save 保存当前工作薄
ThisWorkbook.SaveAs Filename:="C：\User\Desktop\备份.xlsx" 另存为功能
6、案例，将一个工作薄内每个工作表，拆开成多个独立的工作薄
Dim w1 ’定义工作表对象
For Each w1 in WorkSheets
w1.Copy '先进行复制
ActivateWorkbook.SaveAs Filename:="C：\User\Desktop\"& w1.name &".xlsx"
ActivateWorkbook.Close
Next
第9节：单元格
一、Range属性引用
1、引用单个固定的单元格区域
Range("A1:A10")
2、引用多个不连续的单元格区域
Range("A1:A10,A4:E6,C3:D9")
Union(Range("A1:A10"), Range("C1:C10"))
3、引用多个区域的公共区域（相交）
Range("B1:B10 A4:D6")
4、引用两个区域围成的矩形区域
Range("B6:B10", "D2:D8")
5、整行或整列
Range("a6").EntireRow.Select 选择A6单元格所在的那一整行
Range("a6").EntireColumn.Select 选择A6单元格所在的那一整列
二、Cells属性引用
1、引用工作表中指定行列交叉的单元格
工作表对象.Cells(行，列)
ActiveSheet.Cells(3,4)
2、引用单元格区域中某个单元格
Range("B3:F9").Cells(2,3)
3、将Cells属性的返回结果设置为Range属性的参数
Set r = Range(Cells(x, y) , Cells(i, j)) 等效于 range(Ai,Bj)
三、引用整行单元格
1、活动工作表第3行
ActivSheet.Rows("3:3")
ActivSheet.Rows(3)
2、活动工作表第3到5行
ActivSheet.Rows("3:5")
3、活动工作所有行
ActivSheet.Rows
4、3到10行区域中的第1行
Rows("3:10").Rows("1:1")
四、引用整列单元格
1、活动工作表F到G列
ActiveSheet.Colunms("F:G")
2、活动工作表中第6列
ActiveSheet.Colunms(6)
3、活动工作表所有列
ActiveSheet.Colunms
4、B:G列区域中的第2列
Colunms("B:G").Colunms("B:B")
五、清除
六、字体、背景色
r.Font.Clolr=RGB(255,0,0) 文字颜色
r.Font.Size =24 文字大小
r.Font.Italic = True 是否斜体
r.Font.Bold = True 是否粗体
r.Interior.Color=RGB(255,0,0) 单元格背景色
案例：使用With精简代码
Dim r
Set r = Range("A1:A10")
With r.Font
.Clolr = RGB(255, 0, 0)
.Size = 24
.Italic = True
.Bold = True
End With
七、单元格合并取消
r.Merge 合并单元格
r.UnMerge 取消合并单元格
案例：
Sub a()
Dim r
Set r = Range("D1:E2")
r.Merge
End Sub
八、常用对象、属性
1、Range对象的offset(下移行，右移列)
2、Range对象的CurrentRegion连续区域，例如：Range("E7").CurrentRegion.Select
3、Worksheet对象的UsedRange使用区域，例如：ActiveSheet.UsedRange.Select
注意：Usedrange属性并不是单元格的属性，它是工作表的属性，是返回工作表中已经使用了的单元格区域
4、Range对象的End属性
Range("a65536").End(xlUp).Select '选中A列最后一个被使用的单元格
Range("a65536").End(xlUp).Row 'Row是行号，返回数值 （xlToLeft、xlToRight、xlUp、xlDown）
例如：For i = 2 to Range("a1048576").End(xlup).Row ’获取最后一行的行数
irow = Range("a1048576").End(xlup).Row For i = 2 to irow
5、访问Count属性，获得区域中包含单元格的个数
指定区域中单元格的个数
MsgBox Range("B4:F10").Count
活动工作表中已使用区域的行数
ActiveSheet.UsedRange.Rows.Count
活动工作表中已使用区域的列数
ActiveSheet.UsedRange.Columns.Count
6、用Copy方法复制单元格区域
Range(“A7”).EntireRow.Copy Range(“A23”) ‘将A7那一整行拷贝到A23
Range("A1").CurrentRegion.Copy Range("H1") ‘将A1连续区域内的数据进行拷贝
7、用Cut方法剪切单元格
Range("A1").Cut Range("C1")
8、用Delete方法删除指定单元格
九、单元格案例
1、复制行
'将“二班”这一行复制到“二班”工作表数据的下一行
irow = Sheets(“二班”).Range("A1048576").End(xlUp).Row + 1
Sheet1.Range("B" & i).EntireRow.Copy Sheets("二班").Range("A" & irow)
2、清空表
Sheets(i).UsedRange.Clear
3、通过模拟筛选进行复制数据
For i = 2 To Sheets.Count
Sheet1.UsedRange.AutoFilter field:=2, Criteria1:=Sheets(i).Name '选择第二个列，为筛选条件，并且根据Name进行过滤
Sheet1.UsedRange.Copy Sheets(i).Range("A1") '复制过滤后的数据
Next
Sheet1.UsedRange.AutoFilter '恢复到 未设置 筛选条件
4、根据某列数据进行创建表名
Do While Sheet1.Range("A" & i) <> ""
k = 0 '如果有重名K=1就不继续了，每次K=0开始
For Each s1 In Sheets
If s1.Name = Sheet1.Range("B" & i) Then
k = 1
End If
Next
If k = 0 Then
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet1.Range("B" &i)
End If
i = i + 1
Loop
5、MsgBox与InputBox(输入框、对话框)
Dim i
i = InputBox("请输入您的姓名：")
MsgBox "您好" & i & "欢迎回来！"
6、根据指定列，进行拆分数据表
20210901-指定列拆数据-学生基础数据.zip (18.61 K)
第10节：数据类型与日期函数
一、数据类型
1、案例：对内存的消耗时间差不多
Dim 开始时间
开始时间 = Time()
MsgBox "运行时间" & DateDiff("s", 开始时间, Time()) & "秒"
2、案例：&符号放在数字后面时，就把这个数字看成是Long类型
Sub a()
Dim a
a = 30000& * 2
MsgBox a
End Sub
3、案例：使用下划线换行
A：Range("J" & i) = Range("B" & i) _
+ Range("C" & i) + Range("D" & i) _
+ Range("E" & i) + Range("F" & i)
B：拆分字符串，则 & _ 增加一个连接符才可以。
4、数据类型：
二、日期函数
1、#之间表示它是一个日期
a = #7/30/2020 8:08:08 AM#
2、Date日期、Time时间、Now日期+时间
3、函数：
4、案例：HR生日提醒
Dim i
i = 2: j = 1
Do While Range("A" & i) <> ""
If Month(Range("C" & i)) = Month(Date) And Day(Range("C" & i)) = Day(Date) Then
MsgBox "今天是" & Range("A" & i) & "的生日"
Sheets("生日名单").Range("A" & j) = Range("A" & i)
j = j + 1
End If
i = i + 1
Loop
5、DateDiff函数
6、DateAdd函数
第11节：错误处理方式及判断函数、Excel公式
一、逻辑
1、案例：隔人变色
2、GoTo语句：
Dim a, i
i = 1
'设置x为标签，相当于打了一个标记
x: a = a + i
i = i + 1
If i <= 100 Then GoTo x '当条件满足的时候，则返回到标记的位置
MsgBox "从1到100的累加和是：" & a
3、On Error GoTo 标签
Sub 测试()
On Error GoTo a
Sheets("测试").Select
Exit Sub
a: MsgBox "没有这张工作表！"
End Sub
4、On Error Resume Next：开始忽略错误问题
Resume Next告诉VBA如果发生错误，就忽略错误代码的存在，接着执行错误行之后的代码。假设你在程序开始的时候加入这个
语句，即使VBA程序在运行中出错，VBA也不会中断程序，而是忽略所有存在错误的语句，继续执行出错语句后的代码。
5、On Error GoTo 0 ：结束忽略错误问题，搭配 On Error Resume Next 使用。
二、判断函数
IsDate 判断是否为日期、IsNumeric判断是否为数字、TypeName查看变量的数据类型
1、案例：计算保质期
二、Excel公式
1、四舍五入
Dim i, j
i = 3.1415926
j = Excel.Application.WorksheetFunction.Round(i, 2)
MsgBox j
2、统计非空行数量：CountA，扣除标题行
Dim a
a = Excel.Application.WorksheetFunction.CountA(Range("A:A")) - 1
MsgBox a
3、条件计数：CountIf
Excel.Application.WorksheetFunction .CountIf(Range("C:C"), "男")
4、VLookup：从多张表中匹配数据
On Error Resume Next '必须要增加这句话
Dim j, i
j = 2
Do While Range("A" & j) <> 0
For i = 2 To Sheets.Count
Range("B" & j) = Excel.Application.WorksheetFunction.VLookup(Range("A" & j),Sheets(i).Range("A:B"), 2, 0)
Next
j = j + 1
Loop
5、考生成绩统计&查询系统
Sub 查询()
On Error Resume Next
Dim i, a, b, c
Sheets("汇总").Range("D14").ClearContents
For i = 2 To Sheets.Count
With Excel.Application.WorksheetFunction
Set a = Sheets("汇总").Range("D9")
Set b = Sheets(i).Range("A:H")
Set c = Sheets("汇总")
c.Range("D14") = .VLookup(a, b, 5, 0) '姓名
c.Range("D16") = .VLookup(a, b, 6, 0) '性别
c.Range("D18") = .VLookup(a, b, 3, 0) '专业类
c.Range("D20") = .VLookup(a, b, 8, 0) '总分
'在哪张表上找到数据就显示他的表名
c.Range("D22") = Sheets(i).Name
'如果汇总表的D14姓名不为空时就停止循环
If c.Range("D14") <> "" Then
Exit For
End If
End With
Next
End Sub
Sub 统计()
Dim i, a, b
For i = 2 To Sheets.Count
With Excel.Application.WorksheetFunction
Set a = Sheets("汇总")
Set b = Sheets(i)
a.Range("D26") = .CountA(b.Range("A:A")) - 1
a.Range("D27") = .CountIf(b.Range("F:F"), "男")
a.Range("D28") = .CountIf(b.Range("F:F"), "女")
End With
Next
End Sub
第12节：数组
一、数组定义
1、一维数组，定义格式：Dim 数组名称（a To b） As 数据类型
Dim arr（99） As Byte '等同于 Dim arr（0 To 99） As Byte
注意：如果使用一个自然数确定数组大小，默认起始索引号为0，数组共有100个元素
一维数组 【最大索引减最小索引加1】
Ubound(数组名称)-Lbound(数组名称)+1
2、数组的维度：二维数组
3、多维数组声明：
Dim 数组名称 （a To b） As 数据类型
Dim arr(1 To 3, 1 To 5) As Integer '定义了一个3行5列，类型为Integer的二维数组
Dim arr(2，4) As Integer ‘等同于Dim arr(0 To 1，0 To3) As Integer
4、声明动态数组：
动态数组：就是维数不确定或可存储的数据个数不确定。
将数组定义为动态数组以后，可以用ReDim语句重新定义它的大小，ReDim就可以用变量定义了
案例：
Sub test()
Dim a, i
a = Excel.Application.WorksheetFunction.CountA(Range("A:A"))
Dim arr()
ReDim arr(1 To a)
For i = 1 To a
arr(i) = Range("A" & i)
Range("G" & i) = arr(i)
Next
End Sub
5、使用Array函数创建数组
Dim arr
arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
MsgBox "数组第3个元素为" & arr(2)
6、使用Split函数创建数组
Dim arr
arr = Split("你好,你在,哪里", ",")
MsgBox "数组第2个元素为" & arr(1)
7、使用单元格区域赋值
Dim arr
arr = Range("A1:C3")
Range("E1:G3") = arr
8、使用Join函数连接数组内容 语法：Join(数组名称，连接符号)
Dim arr, a
arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
a = Join(arr, "#")
MsgBox a
9、UBound函数求数组最大索引号，LBound最小索引号
Dim arr
arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
MsgBox "数组最大索引号是：" & UBound(arr)
10、多维数组的最大和最小索引号
Dim arr(1 To 3, 1 To 5), a, b
a = UBound(arr, 1) '求一维数组最大索引,注意1参数代表的意思是第一维度
b = UBound(arr, 2) '求二维数组最大索引,注意2参数代表的意思是第二维度
MsgBox "第一维的最大索引号是：" & a & Chr(13) & _
"第二维的最大索引号是：" & b
11、Transpose将数组中的数据写入单元格区域
Dim arr
arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
Range("A1:A8") = Excel.Application.WorksheetFunction.Transpose(arr)
12、案例：A列有1至100这些数字，计算他的累积之和
Sub test()
Dim arr(99), i, j
j = 0
For i = LBound(arr) To UBound(arr)
arr(i) = Range("A" & i + 1)
j = j + arr(i)
Next
MsgBox "数组相加累积之和：" & j
End Sub
13、使用Match获取下标
'记住两个方法，1.求数组最大值Max(arr),2.求数组最大值的下标Match(Max(arr),arr)
With Excel.Application.WorksheetFunction
Range("H3") = .Max(arr)
'因为下标从0开始，所以找到商品名称的单元格要数组最大值下标数+1
k = .Match(Range("H3"), arr) + 1
Range("H2") = Range("A" & k)
第13节：操作TXT文本
一、读取TXT文件
1、步骤：
1、打开文本文件，找到指定文件并调入内容
2、读取一行内容，将每一行当成一个字符串
3、判断是否已到末尾？如果是末尾不再读取
4、关闭文本文件，保存文件【格式调整为：ANSI】，清空内容
2、打开文件
语法：Open 路径和文件名 For 模式 As #文件代号
其中access、lock、reclength为可选参数，一般不用。
模式 指定打开文件的方式。有5种：
Input：以输入方式打开，即读取方式。
Output：以输出方式打开，即写入方式。
Append：以追加方式打开，即添加内容到文件末尾。
Binary：以二进制方式打开。
Random：以随机方式打开，如果未指定方式，则以 Random 方式打开文件。
文件代号，范围在 1 到 511 之间。如果你同时打开多个文件时，指定文件代号的优点是方便调用。也可使用 FreeFile 函数可得到下一个可用的文件号。
说明：如果 pathname 指定的文件不存在，那么，在用 Append、Binary、Output、或 Random 方式打开文件时，可以建立这一文件。
3、读取文件
4、使用EOF判断是否已经到文件末尾
5、关闭文本文件，保存文件，清空内容
二、写入TXT文件
1、步骤：
1、打开文件
2、写入一行
3、关闭文件
Sub test()
Dim i
'写入用output，追加用append
Open "c:\Users\Desktop\李小龙.txt" For Output As #1
i = 2
Do While Range("A" & i) <> ""
Print #1, Trim(Range("A" & i)); '使用 Print 写入，在后面增加 ；分号，则表示追加，不需要换行
Print #1, Trim(Range("B" & i))
i = i + 1
Loop
Close #1
End Sub
2、多张工作表同时写入一个文件
Sub test()
Dim i, s1
Open "c:\Users\Desktop\李小龙.txt" For Output As #1
For Each s1 In Sheets
'每张工作表从第2行开始扫描每一行
i = 2
Do While s1.Range("A" & i) <> ""
Print #1, s1.Range("A" & i); ","; s1.Range("B" & i)
i = i + 1
Loop
Next
Close #1
End Sub
3、多文件的读取与写入
Sub a()
Dim i
Open "C:\Users\Desktop\多文件打开写入\姓名.txt" For Input As #1
Open "C:\Users\Desktop\多文件打开写入\功夫.txt" For Input As #2
i = 1
Do While Not EOF(1) Or Not EOF(2)
If Not EOF(1) Then
Line Input #1, s
Range("A" & i) = s
i = i + 1
End If
If Not EOF(2) Then
Line Input #2, s
Range("A" & i) = s
i = i + 1
End If
Loop
Close #1: Close #2
Open "C:\Users\Desktop\多文件打开写入\合并.txt" For Output As #3
i = 1
Do While Range("A" & i) <> ""
Print #3, Range("A" & i)
i = i + 1
Loop
Close #3
End Sub
第14节：使用Dir函数合并多个文件的数据
一、写参数与不写参数的区别：
Dir(文件夹)：重新返回该文件夹的第一个文件名，不论之前已经找到过多少文件
Dir():接着前一次，继续在同一文件夹中viral下一个文件名
二、注意：Dir函数只能返回文件的名字，他不能返回路径，但是Open语句必须写上盘符和文件名
当Dir函数返回空字符串时，代表所有文件名都已经被找到，本次查找结束。
Sub a()
Dim 文件
文件 = Dir("C:\Users\Desktop\dir\") '返回意大利
文件 = Dir '返回美国
文件 = Dir '返回西班牙
文件 = Dir '返回空
文件 = Dir '报错
MsgBox 文件
End Sub
三、【通用】遍历文件夹下所有的txt文件
Sub 遍历所有txt文件()
Dim 文件
'运行Dir函数得到第1个文件的名字
文件 = Dir("C:\Users\Desktop\多文件打开写入\")
'如果读到的文件不是空字符串，就证明这是一个有效文件
Do While 文件 <> ""
'这里可以对文件进行打开和读取操作
文件 = Dir '再次运行Dir就读到下一个文件名
Loop
End Sub
案例：利用【通用】壳子操作txt
Sub 遍历所有txt文件()
Dim 文件
'运行Dir函数得到第1个文件的名字
文件 = Dir("C:\Users\Desktop\txt\")
'如果读到的文件不是空字符串，就证明这是一个有效文件
Do While 文件 <> ""
'这里可以对文件进行打开和读取操作
Call 读取多个txt文件("C:\Users\Desktop\txt\" & 文件)
文件 = Dir '再次运行Dir就读到下一个文件名
Loop
End Sub
'读取【带路径的文件名】变量中存储的文件
'取出每行国家名称和确诊人数，写入工作表
Sub 读取多个txt文件(带路径的文件名)
Dim i, w1, x
Set w1 = Worksheets.Add
'关于InStrRev函数详见笔记6.3.8
w1.Name = Mid(带路径的文件名, InStrRev(带路径的文件名, "\") + 1)
Open 带路径的文件名 For Input As #1
i = 1
Do While Not EOF(1)
Line Input #1, x
'Split函数详见笔记6.3.10
w1.Range("A" & i) = Split
w1.Range("A" & i) = Split(x, ",")(0)
w1.Range("B" & i) = Split(x, ",")(1)
w1.Range("C" & i) = Split(x, ",")(2)
i = i + 1
Loop
Close #1
End Sub
4、【通用】遍历文件夹下所有的Excel文件
Sub 遍历文件夹下Excel文件()
Dim w1
文件 = Dir("C:\Users\Desktop\excel\")
Do While 文件 <> ""
Set w1 = Workbooks.Open("C:\Users\Desktop\excel\" & 文件)
'此处可以处理当前打开的工作簿
w1.Close
文件 = Dir
Loop
End Sub
5、利用【通用】壳子操作Excel 【工作簿里仅1张表】
Sub 遍历文件夹下Excel文件()
Excel.Application.ScreenUpdating = False
Dim w1
文件 = Dir("C:\Users\Desktop\excel\")
Do While 文件 <> ""
Set w1 = Workbooks.Open("C:\Users\Desktop\excel\" & 文件)
'打开文件并复制第1张表，放在我这个写代码的工作簿里，有几张表就在表后面粘贴
w1.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'刚复制的这张表的表名就是w1那个变量的文件名（不要后缀）
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(w1.Name, ".")(0)
w1.Close
文件 = Dir
Loop
Excel.Application.ScreenUpdating = True
End Sub
6、利用【通用】壳子操作Excel 【工作簿里多张表】
'工作表名 = 文件名+工作表名
Sub 遍历文件夹下Excel文件()
Excel.Application.ScreenUpdating = False
Dim w1
文件 = Dir("C:\Users\Desktop\多表excel\")
Do While 文件 <> ""
Set w1 = Workbooks.Open("C:\Users\Desktop\多表excel\" & 文件)
For Each s1 In w1.Sheets
'复制s1放到工作表最后面
s1.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'刚复制的这张表的表名就是w1那个变量的文件名（不要后缀）
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(w1.Name, ".")(0) & "." & s1.Name
Next
w1.Close
文件 = Dir
Loop
Sheet1.Select
Excel.Application.ScreenUpdating = True
End Sub
7、遍历文件夹下不只是Excel时，但是你只要合并所有Excel文件，有两种方法，各有利弊
方法一：
Sub 遍历文件夹下Excel文件()
Dim w1
文件 = Dir("C:\Users\Desktop\excel\")
Do While 文件 <> ""
'判断是否以xlsx或xls结尾的文件，英文要考虑大小写一致
If LCase(Right(文件, 5)) = ".xlsx" Or LCase(Right(文件, 4)) = ".xls" Then
Set w1 = Workbooks.Open("C:\Users\Desktop\excel" & 文件)
'此处可以处理当前打开的工作簿
w1.Close
End If
文件 = Dir
Loop
End Sub
方法二：
Sub 遍历文件夹下Excel文件()
Dim w1
文件 = Dir("C:\Users\Desktop\excel\*.xlsx")
Do While 文件 <> ""
Set w1 = Workbooks.Open("C:\Users\Desktop\excel" & 文件)
'此处可以处理当前打开的工作簿
w1.Close
文件 = Dir
Loop
End Sub
第15节：Range高阶应用
一、与Range对象位置有关的属性
Range.Rows 单元格行号
Range.Clounms 单元格列号
Range.Address 各对角顶点的绝对引用地址
Range.Count 单元格数量
二、Cells与UsedRange
1、代表工作表中全部单元格的Range对象 【Cells】
Sub a()
Dim i
i=2
i=i+1
Do while range("A"& i)<>"" and i < ActiveSheet.Cells.Rows.Count
loop
End sub
2、涵盖工作表中全部使用过的单元格的Range对象 【UsedRange】
Sub a()
Dim r1, i
'当前工作表所使用的区域
Set r1 = ActiveSheet.UsedRange
'Row从第几行开始+总计多少行-1就得到最后一行的位置了
i = r1.Row + r1.Rows.Count - 1
MsgBox "最后一行是" & i
End Sub
3、【推荐】取得最后一个非空单元格
可设置的参数 参数说明
xlToLeft End+左方向键
xlToRight End+右方向键
xlUp End+上方向键
xlDown End+下方向键
案例：取某列中最后一个非空单元格()
Sub 取某列中最后一个非空单元格()
Dim r
'Range("A" & Rows.Count)获取工作表第一列最后一个单元格
'通过End属性获得A列最后一个非空单元格
Set r = Range("A" & Rows.Count).End(xlUp)
MsgBox r.Row
End Sub
案例：取某行中最后个非空单元格()
Sub 取某行中最后个非空单元格()
Dim r
Set r = Cells(1, Columns.Count).End(xlToLeft)
MsgBox r.Column
End Sub
4、往单元格里写数据，建议配合数组
Sub 配合数组使用()
Dim arr(), i
arr = Range("A1:A1048576")
For i = 1 To 1048576
arr(i, 1) = 1
Next
Range("A1:A1048576") = arr
MsgBox "已经完成"
End Sub
5、选择性粘贴
案例一：Copy单元格保证列宽不变
Sub 单元格拷贝()
Range("B2").CurrentRegion.Copy
With Sheets("Sheet2").Range("A1")
'使用Range对象的PasteSpecial方法选择性粘贴剪贴板中Range对象的列宽
.PasteSpecial xlPasteColumnWidths
'粘贴剪贴板中Range对象全部内容
.PasteSpecial xlPasteAll
End With
'取消应用程序复制模式，如果没有关闭，则会存在选中的状态
Application.CutCopyMode = False
End Sub
6、【选择性粘贴参数】PasteSpecial 方法
PasteSpecial(Paste, Operation, SkipBlanks, Transpose)
参数1：Paste XlPasteType 类型，可选。指定要粘贴的区域部分
参数2：Operation XlPasteSpecialOperation 类型，可选。指定粘贴操作
参数3：SkipBlanks 指示是否跳过空单元格，默认值为Flase，若参数值为True，则不将剪贴板上区域中的空白单元格粘贴到目标区域中
参数4：Transpose 指示是否进行转置，默认值为False，若参数值为True，则粘贴区域时转置行和列
7、直接赋值，速度快 【但是无法保留原数据格式】
以前我们直接赋值，需要写清楚单元格区域和目标单元格区域，先不说你有多累，如果这个区域不固定怎么办？
Sub 直接赋值()
With Range("B2").CurrentRegion
Sheets("Sheet2").Range("A1").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End Sub
8、Intersect获取单元格交叉区域
【通用壳子】
Sub Intersect交叉区域(r1, r2)
Dim 单元格对象
'Intersect方法至少指定两个参数，最多30个，必须是Range对象
Set 单元格对象 = Excel.Application.Intersect(r1, r2)
'如果单元格对象什么都没有（Nothing）
If 单元格对象 Is Nothing Then
MsgBox "不存在交叉区域"
Else
MsgBox "交叉区域地址为：" & 单元格对象.Address
End If
'释放单元格对象占用的内存，不写不会报错，但是数据大了以后会卡死
Set 单元格对象 = Nothing
End Sub
Sub 调用()
Call Intersect交叉区域(Range("C3:G14"), Range("E7:I20"))
End Sub
9、Union单元格多选：Application.Union方法：把多个Range联合在一起，作为一个新的Range对象返回
【通用壳子】
Sub 多选单元格()
'因为省去了set，所以这里要定义成单元格对象
Dim r1 As Range, r2 As Range
For Each r1 In Range("A1:G7")
If r1.Value = "少年" Then
'如果r2对象变为Nothing
If r2 Is Nothing Then
'就指定r2为range对象r1
Set r2 = r1
Else
'否则r2单元格区域与r1对象多选联合后区域重新为r2赋值
Set r2 = Excel.Application.Union(r2, r1)
End If
End If
Next
If Not r2 Is Nothing Then
r2.Select
r2.Interior.Color = vbRed
End If
Set r1 = No
Set r1 = Nothing
Set r2 = Nothing
End Sub
10、单元格边框
案例一：添加边框
Sub 添加边框()
Dim r1 As Range
Set r1 = Range("A1:G7")
With r1.Borders
'边框线条样式
.LineStyle = xlContinuous
'边框线条粗细
.Weight = xlThin
'边框线条颜色
.ColorIndex = 5
End With
'使用BorderAround方法为单元格区域添加一个加粗外框
r1.BorderAround xlContinuous, xlMedium, 5
Set r1 = Nothing
End Sub
案例二：外实内虚
Sub 外实内虚()
Dim r1 As Range
Set r1 = Range("A1:G7")
With r1.Borders(xlInsideHorizontal) ‘内部水平
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = 5
End With
With r1.Borders(xlInsideVertical) ‘内部垂直
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
r1.BorderAround xlContinuous, xlMedium, 5
Set r1 = Nothing
End Sub
案例三：清除线条
Sub 清除线条()
Columns("A:G").Borders.LineStyle = xlNone
End Sub
ColorIndex颜色表
VBA边框的两个属性LineStyle和Weight
11、数据排序
1、语法
Range对象的Sort方法对区域进行排序，其语法格式如下：
Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)
其中Key1、Key2、Key3是可选的，分别代表第1排序字段，第2排序字段，第3排序字段（Range的Sort方法就支持3个字段）
Order1， Order2，Order3是可选的，指的是排序方式（升序或降序），值见下表
xlAscending 升序（默认）
xlDescending 降序
Header是可选的，指定第1行是否包含标题
xlGuess Excel 确定是否有标题，如果有，确定标题位于何处
xlNo 不包含标题(默认)
xlYes 包含标题
2、案例：根据总分排序
Sub 数据排序1()
Range("A1").Sort "总成绩", xlDescending, Header:=xlYes
End Sub
3、案例：支持最多三个字段排序
Sub 数据排序2()
Range("A1").Sort key1:="总成绩", order1:=xlDescending, _
key2:="数学", order2:=xlDescending, _
key3:="语文", order3:=xlDescending, _
Header:=xlYes
End Sub
4、案例：支持三个以上字段排序
Sub 多关键字排序_不推荐()
With Range("A1")
.Sort Key1:="英语", order1:=xlDescending, Header:=xlYes
.Sort Key1:="语文", order1:=xlDescending, Header:=xlYes
.Sort Key1:="数学", order1:=xlDescending, Header:=xlYes
.Sort Key1:="总成绩", order1:=xlDescending, Header:=xlYes
End With
End Sub
5、自定义序列排序
Sub SortByLists()
Dim arr, 序号
arr = Range("E2:E6")
'通过AddCustomList方法为数组添加自定义序列
Excel.Application.AddCustomList arr
'返回数组在自定义序列中的序列号，保存在序号这个变量中
序号 = Application.GetCustomListNum(arr)
'因为OrderCustom从1开始，如果有一行表头我们就要加1
Range("A1").Sort Key1:="部门", Order1:=xlAscending, Header:=xlYes, OrderCustom:=序号 + 1
'使用DeleteCustomList删除新添加的自定义序列
Application.DeleteCustomList 序号
End Sub
第16节：事件编程
一、工作薄事件与工作表事件
1、名称实例：对象名称+事件名称
2、【重要】Workbook事件
3、【重要】Worksheet事件
4、案例：激活工作表，实现透视表刷新功能
Private Sub Worksheet_Activate()
ActiveWorkbook.RefreshAll '刷新透视表
End Sub
二、工作表事件
1、Worksheet_Change（单元格的值变了去执行宏）
1、写一个筛选程序：存在不足之处，会导致死循环
Sub 筛选()
'笔记9.6和笔记9.2
Range("K1").CurrentRegion.Clear
'筛选这个区域内第2列，等于H2单元格的名字
Range("A1").CurrentRegion.AutoFilter field:=2, Criteria1:=Range("H2")
'将这个区域复制到K1单元格
Range("A1").CurrentRegion.Copy Range("K1")
'取消自动筛选
Range("A1").CurrentRegion.AutoFilter
End Sub
2、禁用事件，让事件过程不再自动执行，解决死循环的问题
Private Sub Worksheet_Change(ByVal Target As Range)
'关闭事件
Excel.Application.EnableEvents = False
'因为筛选本身就是修改单元格
Call 筛选
'打开事件
Excel.Application.EnableEvents = True
End Sub
3、第二种解决方案：只要部分单元格被更改时才执行指定的代码
例如只要让某列发生变化时，才执行指定代码
Private Sub Worksheet_Change(ByVal Target As Range)
'判断单元格列号是否为8，也就是H列
If Target.Column = 8 Then
Call 筛选
End If
End Sub
或者
Private Sub Worksheet_Change(ByVal Target As Range)
'判断单元格列号是否为8，也就是H列
If Target.Column <> 8 Then Exit Sub
Call 筛选
End Sub
4、第三种解决方案：例如只要让某单元格发生变化时，才执行指定代码
Private Sub Worksheet_Change(ByVal Target As Range)
'笔记9.10
If Target.Address <> "$H$2" Then Exit Sub
Call 筛选
End Sub
2、Worksheet_SelectionChange （选区发生变化去执行宏）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'改颜色前需要将工作表的背景色改为透明色(xlNone)
Cells.Interior.Color = xlNone
'选中的单元格整行改颜色
Target.EntireRow.Interior.Color = RGB(255, 0, 0)
'选中的单元格整列改颜色
Target.EntireColumn.Interior.Color = RGB(255, 0, 0)
End Sub
3、用批注记录单元格修改情况
'在所有过程之前用Dim语句定义的变量r1是模块级变量，应模块中所有的过程都可以使用它
Dim r1 '定义一个模块给变量，用户保存单元格的数据
'第一个事件过程，用于记录被更改前单元格中保存的数据
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit Sub '选中多个单元格时退出程序
If Target.Formula = "" Then '根据选中单元格中保存的数据，确定给变量r1赋什么值
r1 = "空"
Else
r1 = Target.Text
End If
End Sub
'第二个事件过程，用于批注记录单元格修改前后的信息
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count <> 1 Then Exit Sub
'定义变量保存单元格修改后的内容
Dim r2
'判断单元格是否被修改为空单元格
If Target.Formula = "" Then
r2 = "空"
Else
r2 = Target.Formula
End If
'如果单元格修改前后的内容一样则退出程序
If r1 = r2 Then Exit Sub
'定义一个批注变量
Dim r3
'定义一个变量保存批注内容
Dim r4
'将被修改单元格的批注赋给变量r3
Set r3 = Target.Comment
'如果单元格中没有批注则新建批注
If r3 Is Nothing Then Target.AddComment
'将批注的内容保存到变量r4中
r4 = Target.Comment.Text
'重新修改批注的内容=原批注内容+当前日期和时间+原内容+修改后的新内容
Target.Comment.Text Text:=r4 & Chr(10) & Format(Now(), "yyyy-mm-dd hh:mm") & "原内容:" & r1 & "修改为:" & r2
'根据批注内容自动调整批注大小
Target.Comment.Shape.TextFrame.AutoSize = True
End Sub
4、【进阶】用Change事件模仿收银机
Private Sub Worksheet_Change(ByVal Target As Range)
'同时更改多个单元格时结束执行程序，CountLarge和count功能一样
'CountLarge不会溢出，但是count会，xlsx单元格太多了，容易发生数据类型溢出
If Target.CountLarge <> 1 Then Exit Sub
'输入数据为空时退出
If Target.Value = "" Then Exit Sub
'输入行号是第1行时退出
If Target.Row = 1 Then Exit Sub
'i代表商品表的行数
Dim i
'当输入等于第2列时
If Target.Column = 2 Then
'如果出错了，就是没找到，跳转到标签a
On Error GoTo a
'Excel基础课函数篇06和07，match返回输入的商品名称来自参照表第几行
i = Excel.Application.WorksheetFunction.Match(UCase(Target.Value), Range("H:H"), 0)
'禁止事件，防止将字母改为商品名称时，再次执行程序
Excel.Application.EnableEvents = False
With Target
.Value = Range("I" & i).Value
'笔记9.4 下移行，右移列
.Offset(0, -1).Value = Now
.Offset(0, 1) = Range("J" & i).Value
.Offset(0, 2) = Range("K" & i).Value
'输入商品名称后，选中销售数量的单元格
.Offset(0, 3).Select
End With
Excel.Application.EnableEvents = True
Exit Sub
a: MsgBox "没有该商品，请联系维护人员"
Target.Value = ""
Else
If Target.Column = 5 Then
Application.EnableEvents = False
Target.Offset(0, 1) = Target * Target.Offset(0, -1)
Cells(Target.Row + 1, 2).Select
Application.EnableEvents = True
End If
End If
End Sub
三、工作薄事件
1、Open事件，实现自动选中首页的功能
Private Sub Workbook_Open()
Sheets("首页").Select
End Sub
2、BeforeClose事件：在关闭工作簿之前发生
'Cancel是过程参数，用来确定是否响应关闭操作，值为F关闭，值为T不能关闭
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("你确定要关闭工作簿吗？", vbYesNo) = vbNo Then
Cancel = True
End If
End Sub
恶作剧：永远无法关闭的工作簿
Private Sub Workbook_BeforeClose(Cancel As Boolean)
MsgBox "有本事你把我关闭！"
Cancel = True
End Sub
3、 SheetChange事件：更新任意工作表中的单元格时发生
与工作表中的Change事件不同的是，工作表事件针对 一张工作表，如果你所有工作表都要执行这个事情，就可以用工作簿事件中的SheetChange
当工作簿中任意一张工作表单元格被更改时，都自动执行该事件编写的事件过程
比如那个十字修改颜色的代码就可以写在这里
'sh代表被更改单元格所在的工作表，Target代表被更改的单元格
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox "您正在修改的是:" & Sh.Name & "工作表中的" & Target.Address & "单元格"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub
例如：如果只想让更改名称Sheet1之外的工作表中的单元格，才执行事件过程
'sh代表被更改单元格所在的工作表，Target代表被更改的单元格
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name <> "Sheet1" Then
MsgBox "您正在修改的是:" & Sh.Name & "工作表中的" & Target.Address & "单元格"
End If
End Sub
4、BeforeSave 保存之前执行事件
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ThisWorkbook.SaveCopyAs "c:\" & Format(Now(), "yyyymmddhhmmss") & ".xlsx"
End Sub
注：format相当于Excel函数中的Txet（转成文本函数），Now()返回现在日期时间函数，yyyymmddhhmmss指的是年月日时分秒的格式。
如果你想知道谁喜欢偷看你电脑上的文件，你可以在打开工作簿事件中，写上这行代码，当你发现具体日期和时间被人查看过文件后，去调监控吧
5、NewSheet创建新表时，复制一张新的模板
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sheets("表1").UsedRange.Copy Sh.Range("A1")
Sh.Range("A2:F11").Value = ""
End Sub
6、让文件自动保存
Sub otime()
'10秒后自动运行WbSave过程
Application.OnTime Now() + TimeValue("00:00:10"), "WbSave"
End Sub
Sub WbSave()
ThisWorkbook.Save '保存本工作簿
Call otime '再次运行otime过程
End Sub
为了让工作簿打开就自动运行：
Private Sub Workbook_Open()
Call otime
End Sub
7、【重要资料】MsgBox语法和参数
第17节：用户信息交互
一、InputBox函数
1、参数定义：
InputBox函数共有5个参数：
prompt：用于设置在对话框中显示的提示信息
Title：用于设置对话框的标题
Default：是对话框中默认的输入值
xpos：用于设置对话框左端与屏幕左端的距离
ypos：是对话框的顶端与屏幕顶端的距离
2、案例：
Sub a()
Dim i
i = InputBox(prompt:="我是提示信息", Title:="我是标题", Default:="默认输入值", xpos:=2000, ypos:=2500)
Range("A1") = i
End Sub
可以简写：但是位置不能变，只有prompt必选，其它都是可选，如果中间的参数省略一定要用逗号隔开
Sub a()
Dim i
i = InputBox("我是提示信息", "我是标题", "默认输入值", 2000, 2500)
Range("A1") = i
End Sub
二、InputBox方法
1、Inputbox方法Type参数的可设置项及说明
2、案例：
Sub a()
Dim i
i = Excel.Application.InputBox(prompt:="我是提示信息", Title:="我是标题", Default:="默认输入值", Left:=2000, Top:=2500, Type:=1)
Range("A1") = i
End Sub
三、MsgBox语法和参数
1、语法与参数
四、【获取路径+文件名】 GetOpenFilename方法
1、定义及参数
GetOpenFilename方法：获得在对话框中选中的文件的文件名称（包含路径）
如果你希望程序在运行过程中，手动选择文件，再根据文件路径及名称进行其它操作，就使用GetOpenFilename方法
例如：多个工作簿合并其内容，运行中可以让用户手工选择文件进行合并。
参数：
GetOpenFilename (文件类型，优先类型(1或2)，对话框标题，按钮文字，是否支持多选)
GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
2、案例1：让对话框显示所有类型的文件
Sub a()
Dim i
i = Excel.Application.GetOpenFilename
If i = False Then
MsgBox "没有选择任何文件！"
Exit Sub
Else
Range("A1") = i
End If
End Sub
3、案例2：只在对话框中显示指定类型的文件
Sub a()
Dim i
i = Excel.Application.GetOpenFilename("图片文件,*.jpg")
If i = False Then
MsgBox "没有选择任何文件！"
Exit Sub
Else
Range("A1") = i
End If
End Sub
4、案例3：让对话框同时显示同一类型的多种扩展名的文件
Sub a()
Dim i
i = Excel.Application.GetOpenFilename("Excel文件,*.xls;*.xlsx;*.xlsm") '注意：后缀是分号
If i = False Then
MsgBox "没有选择任何文件！"
Exit Sub
Else
Range("A1") = i
End If
End Sub
5、案例4：让对话框选择显示多种类型的文件
Sub a()
Dim i
i = Excel.Application.GetOpenFilename("Excel文件,*.xls;*.xlsx;*.xlsm,Word文件,*.doc;*.docx;*.docm")
If i = False Then
MsgBox "没有选择任何文件！"
Exit Sub
Else
Range("A1") = i
End If
End Sub
6、案例5：通过FilterIndex参数设置默认显示的文件类型
Sub a()
Dim i
i = Excel.Application.GetOpenFilename("Excel文件,*.xls;*.xlsx;*.xlsm,Word文件,*.doc;*.docx;*.docm", FilterIndex:=2)
If i = False Then
MsgBox "没有选择任何文件！"
Exit Sub
Else
Range("A1") = i
End If
End Sub
7、案例6：设置允许同时选择多个文件
Sub a()
Dim i
i = Excel.Application.GetOpenFilename("Excel文件,*.xls;*.xlsx;*.xlsm", MultiSelect:=True)
If IsArray(i) Then
Range("A1").Resize(UBound(i), 1) = Excel.Application.WorksheetFunction.Transpose(i)
Else
MsgBox "已取消操作！"
End If
End Sub
五、【另存为】对话框 GetSaveAsFilename方法
Sub a()
Dim i
文件名 = "孙兴华"
文件类型 = "Excel文件,*.xls;*.xlsx;*.xlsm,word文件,*.doc;*.docx;*.docm"
标题 = "我是标题"
i = Excel.Application.GetSaveAsFilename(InitialFileName:=文件名, filefilter:=文件类型, FilterIndex:=2, Title:=标题)
Range("A1") = i
End Sub
六、【获取路径】FileDialog属性【用处不大】
1、定义：
只需要获取路径，不要文件名
Excel.Application.FileDialog(filedialogtype:=参数)
参数见下表
msoFileDialogFilePicker
允许选择一个文件
msoFileDialogFolderPicker 允许选择一个文件夹
msoFileDialogOpen
允许打开一个文件
msoFileDialogSaveAs
允许保存一个文件
Sub test1() '选择文件
Dim dig
Set dig = Application.FileDialog(msoFileDialogFilePicker) '定义对象，指定参数
With dig
.AllowMultiSelect = True '允许多选
.Filters.Add "Excel文件", "*.xls*", 1 '默认文件类型
.InitialFileName = ThisWorkbook.FullName ''d:\' '默认路径
.InitialView = msoFileDialogViewDetails '文件显示方式
.Title = "对话框测试" '对话框标题
If .Show = 0 Then 'show显示对话框，判断返回值
MsgBox "你点了取消"
Else
MsgBox dig.SelectedItems(1) '取得选择的文件名
End If
End With
End Sub
注：这里显示对话框用到的是show方法，而show方法是可以返回值的，返回0代表点了取消，否则返回-1。选择的文件名称是保存在SelectedItems数组中，通过该数组来调用相应的文件名，选了一个可以单独调用，多个就循
环调用。
Sub test2() '选择文件夹
Dim dig
Set dig = Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹
With dig
.AllowMultiSelect = True
.InitialFileName = "D:\"
.Title = "对话框测试"
If .Show = 0 Then
MsgBox "你点了取消"
Else
MsgBox dig.SelectedItems(1)
End If
End With
End Sub
Sub test3() '打开文件
Dim dig
Set dig = Application.FileDialog(msoFileDialogOpen)
With dig
.AllowMultiSelect = True
.Filters.Add "Excel文件", "*.xls*", 1
.InitialFileName = "D:\"
.Title = "对话框测试"
If .Show = 0 Then '判断是否点了取消
MsgBox "你点了取消"
Else
.Execute '执行打开命令
MsgBox "文件已打开"
End If
End With
End Sub
注：执行打开命令需要在Show方法之后调用Execute方法，而之前的两个代码是没有Execute方法的，如果在Show之后不执行Execute那这个代码也可以用来返回文件名，和前两个代码没有区别。
Sub test4() '另存文件
Dim dig
Set dig = Application.FileDialog(msoFileDialogSaveAs)
With dig
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.FullName
.Title = "对话框测试"
If .Show = 0 Then '判断是否点了取消
MsgBox "你点了取消"
Else
.Execute '执行打开命令
MsgBox "文件已保存"
End If
End With
End Sub
2、【通用】文件选择对话框
'选择单个文件对话框
Sub SelectSingleFileDialog()
'通过对话框选择文件
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select A File" '选择窗口的标题
.InitialFileName = "D:\TestFolder\TestFile.txt" '初次打开窗口的路径以及默认名称
.AllowMultiSelect = False '是否允许选择多个文件
.Filters.Clear '清除现有规则
.Filters.Add "Text File", "*.txt" '增加规则
.Filters.Add "EXCEL File", "*.xlsx; *.xls", 1 '增加规则到第一位
.Filters.Add "All File", "*.*", 1 '增加规则到第一位
If .Show Then '显示文件选择对话框
.ButtonName = "Select Me"
Set ipath = .SelectedItems '获取选择项,无论是否选择一项还是多项，返回的选项都是多项
End If
End With
If IsEmpty(ipath) Then Exit Sub '如果按取消键，退出
ipath = ipath(1) '获取第一项选择
Debug.Print ipath '输出选择文件名
End Sub
3、【通用】文件夹选择对话框
'选择一个文件夹
Sub SelectFolderDialog()
'通过对话框选择文件夹
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Folders"
If .Show Then
ipath = .SelectedItems
End If
End With
If IsEmpty(ipath) Then Exit Sub '如果按取消键，退出
Debug.Print ipath(1) '输出文件夹路径
End Sub
七、实战1：打开一个或多个文件并写入数据【多选】
Sub a()
Dim i, w1, arr
arr = Excel.Application.GetOpenFilename("Excel文件,*.xls*", MultiSelect:=True)
If IsArray(arr) Then
For i = LBound(arr) To UBound(arr)
Set w1 = Workbooks.Open(arr(i))
w1.Sheets(1).Range("A1") = 520
w1.Save
w1.Close
Next
Else
MsgBox "已取消操作！"
End If
End Sub
八、实战2：多个Excel文件合并
Sub a()
Dim i, w1, arr
Set w2 = ActiveWorkbook
Set s2 = ActiveSheet
arr = Excel.Application.GetOpenFilename("Excel文件,*.xls*", MultiSelect:=True)
If IsArray(arr) Then
For i = LBound(arr) To UBound(arr)
Set w1 = Workbooks.Open(arr(i))
For Each s1 In w1.Sheets
s1.Copy after:=w2.Sheets(w2.Sheets.Count)
w2.Sheets(w2.Sheets.Count).Name = Split(w1.Name, ".")(0) & s1.Name
w1.Close
Next
Next
End If
End Sub
第18节：图形界面设计
一、在工作中使用
1、表单控件
2、ActiveX控件
表单控件与ActiveX控件区别：
表单控件：只能用来指定宏，只能用在工作表中
ActiveX控件：有很多属性和事件,不仅可以用在工作表中，也可以使用在窗体中
二、窗体对象设计交互界面
1、VBE-【插入】-【用户窗体】
2、在插入模块那里，选择用户窗体
3、常用窗体属性
三、增加和设置控件
1、【用户输入】TextBox文本框
2、【选择菜单】ComboBox复合文本框
3、【显示内容】 Lable标签
4、【命令按钮】CommandButton
5、案例：
Private Sub 确定_Click()
Dim r1 As Range, i As Long
Set r1 = Worksheets(1).UsedRange
'i代表当前表格最后一行数据的下一行
'起始行+使用区域一共多少行
i = r1.Row + r1.Rows.Count
Range("A" & i) = txt姓名.Value
Range("B" & i) = txt性别.Value
Range("C" & i) = txt成绩.Value
'将窗体中输入的数据清除，等待下次输入
txt姓名.Value = ""
txt性别.Value = ""
txt成绩.Value = ""
End Sub
6、窗体的显示位置
默认情况下，显示一个窗体时，Excel会将其显示在Excel窗口的中心位置，但可以通过设置属性来定义其显示的位置。
在模块里面写：
Sub 显示窗口()
With UserForm1
'属性为0时，可以设置窗体初次显示时的位置由用户定义
.StartUpPosition = 0
'设置窗体顶端离屏幕窗口顶端的距离
.Top = 100
'设置窗体左商离屏幕窗口左端的距离
.Left = 200
.Show
End With
End Sub
也可以在属性里设置：
7、文件打开时就自动显示窗体
8、操作窗体之外的内容
9、【显示/隐藏】窗体
UserForm1.Show ： 显示窗体
UserForm1.Hide ： 隐藏窗体
10、【关闭】窗体
关闭窗体方法：Unload 窗体名称
关闭代码所在的窗体：Unload Me
二者区别：
使用【Unload 窗体名称】可以关闭任意的窗体
使用【Unload Me】只能关闭代码所在的窗体
如果是要关闭代码所在的窗体，使用【Unload Me】关闭会更安全。
因为：如果用【Unload 窗体名称】依赖于窗体名称，如果窗体名称改变了，你就要回来改代码。如果用
【Unload Me】无论你的窗体名称怎么变，都不用关心代码问题。
那么【关闭】和【隐藏】有什么区别呢？
关闭：不但会从屏幕上删除，还会将其从内存中卸载，当窗体从内存中卸载后，窗体及窗体中的控件都将还原成
最初的值，代码将不能操作或访问窗体及其中的控件，也不能再访问保存在窗体中的变量。
隐藏：只是从屏幕上消失，等候你再次使用。
就好比一个你输入了很多文字的Word文档，你没保存到硬盘上，它就保存在内存中，你关闭了，就没有了，你
最小化，就叫隐藏。
双击【取消】按钮
Private Sub 取消_Click()
Unload Me
End Sub
11、【禁止关闭窗体】利用Queryclose事件
12、给控件设置快捷键
13、更改控件的Tab顺序：视图——Tab键顺序
14、在表格上双击某一行数据自动弹出窗体
15、多行文本的相关参数
16、【选择题】ListBox列表框
Private Sub UserForm_Initialize()
数据列表.List = Array("张三", "李四", "王五")
End Sub
1、向列表框中添加项目：
列表.AddItem "新的项目"
2、从列表框中删除项目：
列表.RemoveItem num
num(从0开始计数)
3、被用户选中的项目序号
列表.listindex
从0开始计数，用户未做任何选择，则为-1
Private Sub 删除_Click()
If 列表.ListIndex <> -1 Then
列表.RemoveItem 列表.ListIndex
End If
End Sub
Private Sub 添加_Click()
If 文本.Value <> "" Then
列表.AddItem 文本.Value
文本.Value = ""
End If
End Sub
Private Sub 显示人名_Click()
'避免用户没有选择就点了按钮
If Not IsNull(列表.Value) Then
MsgBox 列表.Value
End If
End Sub
【补充】常用属性和方法
17、选项按钮和复选框：他们的Value被选中时为True,否则为False
Private Sub 确定_Click()
Dim 变量1, 变量2
'因为返回值都是T或F
If 男.Value Then
变量1 = 男.Caption '如果想让值等于按钮或选框名字的时候，例如： 按钮.Caption
ElseIf 女.Value Then
变量1 = 女.Caption
End If
Range("A2") = 变量1
'注意复选框不要用Elseif因为是多选
If 协议.Value Then 变量2 = 变量2 & 协议.Caption
If 体验.Value Then 变量2 = 变量2 & 体验.Caption
Range("B2") = 变量2
End Sub
18、可用性Ebable和可见性Visible
可用性Ebable ：值为F,按钮为灰色不可用
可见性Visible：值为F,按钮被隐藏
启用.Enable=True
禁用.Enable=False
显示.Visible=True
隐藏.Visible=False
19、【旋转按钮】SpinButton
除了可见性，可用性 和 标题之外还多了两个属性
MIN最小值 和 MAX最大值
它的事件中没有单击，只有改变
20、常用窗体事件
UserForm.Activate 激活
UserForm.QueryClose 退出
第19节：登录页面案例
编辑于 2021-10-5 06:39
