第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