VBA常用代码

定义变量


Sub myTest()
    Dim MyName, Sht as WorkSheet,wk as WorkBook     '定义变量
    MyName = "XXXX"                       '普通变量
    Set wk = WorkBook("XXX工作薄.xlsx")    '变量为工作薄
    Set sht = sheets("XXX工作表")          '变量为工作表
End Sub

注意：变量为工作薄和工作表时必须使用set

条件语句

1.单条件

（1）单行写法 (后面将省去首尾两句）


xxxxxxxxxx
Sub Test()
If 条件 Then 语句
end sub

使用函数： iif(条件, 真, 假)


xxxxxxxxxx
IIf(myName="XX", "OK", "ERROR")         'myName是变量

（2）多行写法


x
If 条件 Then
  语句
End If

’if-else
If 条件 Then
  语句1
Else
  语句2
End If

2.多条件

（1）if ... else if ... else if ... end if


xxxxxxxxxx
if 条件1 then
  语句1
Else If 条件2 then
  语句2
......
Else
  所有条件都不成立时运行的语句
End If

（2）Select Case ... case Is ... End Select


xxxxxxxxxx
Select Case Range("A8").value   '或者Cells(i, "B")
    Case Is < 0
    sign = "负数"
    Case Is > 0
    sign = "正数"
    Case Else
    sign = "零"
End Select

循环语句

For ... Next


xxxxxxxxxx
for 变量 = 初始值 to 终值  step 步长         '如果省略step不写，默认步长为1
  语句
next 变量 '可省略变量

For Each ... Next


xxxxxxxxxx
for each 变量 in 数组（指定的集合）
  语句
  [Exit for]    '终止循环'
next 变量

Do While ... Loop


xxxxxxxxxx
‘先判断，再决定是否执行
do while 条件
  语句
loop

Do ... Loop While


xxxxxxxxxx
’先执行后，再判断。
do 
  语句
loop until 条件

While ... Wend


xxxxxxxxxx
while 条件
  语句
wend

Union(区域1，区域2，.....)联合区域


xxxxxxxxxx
for each 变量 in Union(Range('a1:a10'), Range('c4:c12'))
  代码
next 变量

结束、终止程序

1. 终止程序（END）

End语句可以单独使用，也可以结合部分控制关键字使用，如Function、If、Select、Sub、With等。End语句用于立即结束一个过程或者块，它提供了一种强制中止程序或结束语句块的方法。


xxxxxxxxxx
sub test()
    if a=1 Then
        MsgBox "错误退出程序"
        End         '结束运行过程
    End If
EndSub

2.退出、跳出（EXIT）

Exit语句用于强制退出Do-Loop、For、Function函数、Sub过程或者Property等代码块，该语句只有结合其他关键字才可发挥作用。

（1）For循环的退出


xxxxxxxxxx
For Each myCell in Range("A1:H10")
　　　If myCell.Value = "" Then
　　　　myCell.Value = "empty"
　　　Else
　　　　Exit For    '退出循环
　　　End If
Next myCell

如果是For to 结构的循环，同样使用Exit For语句来退出。

（2）Do 或 Do While语句的退出


xxxxxxxxxx
Exit Do

（3）退出Sub过程


xxxxxxxxxx
Exit Sub

（4）退出函数Fuction


xxxxxxxxxx
Exit Function

（5）结束本次或跳过

VBA中没有continue和break，循环的终止通过exit do或exit for实现。

如果仅仅跳出该次循环的话，建议用goto加行号跳转，或者if else 判断的时候不写执行内容实现跳过循环。

With语句

重复代码部分的简写


xxxxxxxxxx
With 
    ......
End With

GoTo 语句

1.基本用法

GoTo XXX标签

（1）XXXX参数可以是任意的行标签或行号。

（2）GoTo 只能跳到它本身所在过程中的行，不能跳转到其它Sub过程中去。


xxxxxxxxxx
Sub myTest()
    Dim a
    if a=1  goto line1 else goto line2
    line1:          '标签1
        代码1...
    line2:          '标签2
        代码2...
End Sub

2. On...GoSub / On...GoTo


xxxxxxxxxx
On Error GoTo XX标签      '如果错误产生, 则跳转到某行/标签
On Error Resume Next    '如果错误产生, 则继续下一条语句
On Error GoTo 0         '清除当前设置的错误陷阱


xxxxxxxxxx
On Error GoTo XX标签      '如果遇到错误就跳转到标签
  ......
  Exit Sub/Function      '如果没有这个退出过程语句，就会依次执行后面的所有语句

XX标签: 
    ......

获得错误码代号（数字）： Err.number


xxxxxxxxxx
Sub myTest()  
    On Error Resume Next
    ......
    If Err.number = 9 then
        MsgBox ("ERROR")
    End If
End Sub

字典

1.定义


xxxxxxxxxx
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")

2.方法

字典有6个成员方法：Add、Exists、Keys、Items、Remove、RemoveAll

（1）添加内容


xxxxxxxxxx
d.Add key, item     '例：d.Add '优秀', 80
d(key) = item       '例：dic('及格') = 60'

（2）d.Exists(key)

判断键是否存在于字典中；如果存在，返回True，否则返回False。

（3）d.Keys()

获取字典所有的键，返回类型是一维数组（数组下标从0开始）

字典使用for each next结构进行遍历时，返回的是key

For Each di In d 也可以写成For Each di In d.keys

（4）d.Items()

获取字典所有的值，返回类型是一维数组。

（5）d.Remove(key)

从字典中移除一个条目，是通过键来指定的。如果指定的键不存在，会发生错误。

（6）d.RemoveAll

清空字典

3.属性

字典有4个属性：Count、Key、Item、ConpareMode。

（1）Count

用于统计字典中键－值对的数量。也可以简单理解为统计字典中键的个数。

（2）Key

用于更改字典中已有的键。如果指定的键不存在，则会产生错误。


xxxxxxxxxx
d.Key('apple') = 'Orange'

（3）Item

用于写入或读取字典中指定键的值，如果指定的键不存在，则会新增。


xxxxxxxxxx
Debug.Print d.Item('apple')     '读取
d.Item('apple') = 10    '写入
d('apple')=10       ‘与上面写入一样

（4）CompareMode

当用字符串做为key时是否区分大小写，如 Dic.CompareMode=1不区分大小写，Dic.CompareMode=0区分大小写；默认是区分大小写的。

总结：通过key键访问字典元素item值


xxxxxxxxxx
Cells(1, 1) = d('a')
Cells(1, 1) = d.Item('a') '与上者相同

4.转置


xxxxxxxxxx
Dim d As Object
Set d = CreateObject("scripting.dictionary")                    '引用
Range("A1").Resize(d.Count, 1) = Application.Transpose(d.keys)  '字典的键转成1列
Range("A1").Resize(d.Count, 1) = Application.Transpose(d.items)  '字典的值转成1列
Range("A1").Resize(1,d.Count) = dic.keys        ’字典的键成一行
Range("A1").Resize(1,d.Count) = dic.items       ’字典的值成一行
'键和值转成两列写入表格
Range("A1").Resize(d.Count, 2) = Application.Transpose(Array(d.keys,d.items))

数组

静态（常量）数组

1.直接定义数组有多少个元素。括号里的数值n为上标值，下标从0开始到上标n。


xxxxxxxxxx
Dim Arr(2) As Variant           '定义一个下标为0，上标为2的一维数组,共计3个元素
Dim Arr(2)      ’默认索引从0开始
Arr(0) = 1      
Arr(1) = 2
Arr(2) = 3  

Dim Arr(1 to 10)                '定义一个下标为1，上标为10的一维数组,共计10个元素
Arr(1) = "A"
......
Arr(10) = "J"

Dim arr(1 To 10, 1 To 2) As Integer '定义一个10*2的二维数组（10行，2列），其中个数不能使用变量。

Dim arr(1, 1) As Variant        'Dim arr(0 To 1, 0 To 1) As Variant
    'arr(0,0),arr(0,1),arr(1,0),arr(1,1)    4个元素，默认索引从0开始

2.用Array函数创建


xxxxxxxxxx
Dim arr As Variant      
arr = Array("vba", 100, 3.14)           '一维数组
arr = Array(Array("张三", 100), Array("李四", 76), Array("王五", 80))         '二维数组

3.调用Excel工作表内存数组


xxxxxxxxxx
Dim arr1,arr2
arr1 = [{"A","B",1,2}]                  '一维数组，用逗号分隔
arr2 = [{"a",10; "b",20 ; "c",30}]      '二维数组，分号分隔，表示一行

动态数组

如果定义为 din arr1() as variant 或 dim arr1() 缺省，都会默认为，可以存储变量的数组。


xxxxxxxxxx
Dim arr1()              '声明一个动态数组（动态指不固定大小）
Dim arr2                '声明一个Variant类型的变量
arr1 = Range("a1:b2")   '把单元格区域A1：B2的值装入数组arr1
arr2 = Range("a1:b2")   '把单元格区域A1：B2的值装入数组arr2

ReDim arr(1 To n)       '重新定义数组大小，共有n个元素

可直接定义，但是不能直接赋值


xxxxxxxxxx
Dim arr()
ReDim arr(2)
arr(0) = 1
arr(1) = 2
arr(2) = 3
’以下错误 （必须定义元素个数后才可以给一个元素赋值）
dim arr()
arr(0) = 1
arr(1) = 2

元素个数

上限： Ubound(array)
下限： Lbound(array)
数组元素个数：上限 - 下限 + 1

二维个数：


xxxxxxxxxx
Ubound(array,1)     '行数
Ubound(array,2)     '列数

数组赋值与单元格的维度

1、一般的赋值


xxxxxxxxxx
dim arr(2)  '定义了3个元素的一维数组，下标默认从0开始
Arr(0) = Range("A1")        
Arr(1) = Range("A2")
Arr(2) = Range("A3")

2、将单元格写入数组

将某一个区域中单元格的数值赋给数组，无论是读取一行、一列、多行多列，数组都是二维的。


xxxxxxxxxx
'(1)从一列单元格中的数据写入数组,返回arr1（二维）
arr1 = Range("A1:A4")   '将一列生成二维arr1(4,1)，4行1列，下标默认从1开始

'(2)从一行单元格中的数据写入数组,返回arr2（二维）
arr2 = Range("A1:D1")   '将一行生成二维arr2(1,3), 1行3列, 并不是一维的,下标默认从1开始

'(3)从多行多列单元格中的数据写入数组,返回arr3（二维）
arr3 = Range("A1:D4")   '将多行多列生成二维arr3(4,4), 4行4列，下标默认从1开始

3、将数组写入单元格

（1）写入一行，需要一维或者二维（1，n）


xxxxxxxxxx
'一维
arr1 = [{1,2,3}]
Range("A1:C1") = arr1

'二维
'方式1
arr = Range("A1:C1")
Range("A5:C5") = arr

'方式2
Dim arr(1, 3)
arr(0, 0) = 11
arr(0, 1) = 12
arr(0, 2) = 13
Range("A1:C1") = arr

（2）写入一列，需要二维


xxxxxxxxxx
arr2 = [{1; 2; 3}]
Range("A1:A3") = arr2

（3）写入多行多列，需要二维


xxxxxxxxxx
arr3 = [{1,2,3;"A","B","C"}]
Range("A1:C2") = arr3

（4）取一列写入一行，需要转置


xxxxxxxxxx
arr4 = Range("A1:A4")
Range("A1:D1") = Application.Transpose(arr4)

4、在二维中取出一行或者一列

（1）取出一行，结果是一维


xxxxxxxxxx
arr = Range("A1:B5")    '二维(5行，2列)
Application.Index(arr, 2, 0)  ’取出第2行，结果数组是一维

（2）取出一列，结果是二维


xxxxxxxxxx
Application.Index(arr, 0, 2)  ‘取出第2列，结果数组是二维（多行，1列）

（3）将一列单元格的数值写入一行单元格，需要转置，也就是n行1列,转成1行n列。


xxxxxxxxxx
Dim arr
arr = Range("A1:A8")                '读取一列单元格数据，这也是二维
Range("C1：H1") = Application.Transpose(arr)            '写入一行
Range("C1").Resize(1, 8) = Application.Transpose(arr)   ’写入一行
Range("D1").Resize(8, 1) = arr      '写入一列单元格

总结：

（1）一维数组下标默认为 0；二维数组中下标默认为 1；

（2）一维数组写入单元格时为一行，但一行单元格写入数组时为二维（1行，几列）；

（3）将一行或者一列单元格数值写入数组，都是二维的。

数组的合并（join）与拆分（split）


xxxxxxxxxx
Dim a As Variant
Dim b As Variant
  ' Join using spaces
a = Array("Red", "Blue", "Yellow")
b = Join(a, "-")        'Red-Bule-Yellow


xxxxxxxxxx
Dim a As Variant
a = Split("Red$Blue$Yellow", "$")     'a = Array("red"，"blue"，"yellow")

数组的筛选（Filter）


xxxxxxxxxx
arr = Array("ABC", "F", "D", "CA", "ER")
arr1 = VBA.Filter(arr, "A", True)               '筛选所有含A的数值组成一个新数组
arr2 = VBA.Filter(arr, "A", False)              '筛选所有不含A的数值组成一个新数组

数组维度的转换（Transpose）


xxxxxxxxxx
'一维转二维
arr = Array(10, "vba", 2, "b", 3)
arr1 = Application.Transpose(arr)   '转换后的数组是1列多行的二维数组


xxxxxxxxxx
'二维数组转一维    注意:在转置时只有1列N行的数组才能直接转置成一维数组
arr2 = Range("A1:B5")
arr3 = Application.Transpose(Application.Index(arr2,0,2)) '取得arr2第2列数据并转置成1维数组

判断元素是否在数组中

数组只能用循环或者遍历了，如果是excel中的，还可以用worksheetfunction.match 判断元素是否存在，可以考虑把数组转变成字典，字典对于这个问题处理起来就很轻松了。


xxxxxxxxxx
'判断元素
if dic.exists("XX")=true then msgbox "XX存在"

判断是一维还是二维

没有直接的函数，一般用变通的方法，用错误获取。


xxxxxxxxxx
Sub A_num()
    On Error Resume Next
    Dim a As Variant, ln As Long
    '一维数组 a = Array(1, 2, 4, 5)
    a = [{1,3,4;1,3,5}]     '这是二维数组
    ln = UBound(a, 2)
    If Err Then
        MsgBox "一维数组"
    Else
        MsgBox "二维数组"
    End If
End Sub

二维数组

提取一行或一列转成一维数组

注意：arr = Range("A1:C1")，是生成二维数组，1行3列，并不是一维的。


xxxxxxxxxx
Dim DataArr, arr1, arr2
DataArr = Range("A1:D8") ’8行4列的二维数组

'取一行成一维，以第1行为例：
arr1 = Application.Index(DataArr,1,0)   '取出第1行
Range("A10,D10") = arr1         '写入表格第10行
'取一列成一维，以第4列为例：
arr2 = Application.Index(Application.Transpose(DataArr),4,0)    '先转换行列，再取第4行，也就是原来的第4列
arr2 = Application.Transpose(Application.Index(arr, 0, 4))      '先取出第4列，再转成一行
Range("K1:K8") = arr2   '将一维arr2写入表格K列


xxxxxxxxxx

行数和列数


xxxxxxxxxx
row = UBound(arr, 1)    '有多少行数
col = UBound(arr, 2)    '有多少列数

与Index取行取列


xxxxxxxxxx
arr = Range("A1:D3")
Range("A11:D11") = Application.Index(arr, 3, 0)     '取出第3行写入单元格，是一行
Range("A11:A13") = Application.Index(arr, 0, 2)     '取出第2列写入单元格，是一列
Range("A11:C11") = Application.Transpose(Application.Index(arr, 0, 2))  '取出第2列，写入一行

关于for each 循环

1.遍历数组的每一个元素，并不是按行遍历；

例如：arr(2,3)遍历时会有2*3=6次，即每一个元素。

2.当二维数组为一列时，刚好每次遍历一行。

例：arr=range("A1:A10")


xxxxxxxxxx
arr=range("A1:A10")
for each x in arr
    x ‘正好是每行数据，因为只有一列。  
next

ReDim Preserve 关键字

1.如果使用了 Preserve 关键字，就只能重定义数组最末维的大小，且根本不能改变维数的数目。

2.如果数组就是一维的，则可以重定义该维的大小，因为它是最末维，也是仅有的一维。

3.如果数组是二维或更多维时，则只有改变其最末维才能同时仍保留数组中的内容。

关于某一行、某一列

1.选中某一行、某一列


xxxxxxxxxx
Worksheets(Sheet1).Activate
ActiveSheet.Range("1:1").Select     '选取第1行
ActiveSheet.Range("B:B").Select     '选取第B列

Rows(5).Select          '选取第5行
Rows(1:5).Select        '选取第1到5行
dim y = 10
Rows("1:" & y).Select   '选取第1到10行

Columns(5).Select       '选取第5列
Columns(1:5).Select     '选取第1到5列

2.根据单元格选中一行一列


xxxxxxxxxx
Worksheets("工作表名称").Range("单元格范围").Find(要查找的值).EntireRow.Select

Find 方法返回一个 Range 对象，也就是找到的那个单元格对象，然后再用这个对象的 EntireRow 来引用所在的整行。

注意，上述代码没有容错判断，如果在指定范围内没有“要查找的值”，代码会出错。


xxxxxxxxxx
Cells(i, 1).EntireRow.Select        '选中单元格所在行
Cells(i, 1).EntireColumn.Select     '选中单元格所在列
Rows(Range("A1").Row).Select        '选中一行
Column(Range("A1").Column).Select   '选中一列

3.最后一行和一列

方法1


xxxxxxxxxx
UsedRange.Rows.Count 
UsedRange.Columns.Count

缺点：有时可能会比实际数大一些，原因是如果你把最后几行（列）数据清除后（非整行或整列删除），用这个命令仍返回未清除前的值。就是说现在虽然是空的，但是你曾经用过也算你的。

方法2（最常用）


xxxxxxxxxx
Range("A65535").End(xlUp).Row       '最后一行
Range("IV1").End(xlToLeft).Column   '最后一列
Cells(n, Columns.Count).End(xlToLeft).Column    '求n行最后一列的列数

可以简写为


xxxxxxxxxx
[A65536].End(xlUp).Row
[IV1].End(xlToLeft).Column

缺点：只能计算出一列（行）的最后一个单元格所在的行（列）数。本例是只返回A列最后一个单元格所占的行数。

4.在最后一个单元格后写入数据

单元格End属性：xlToLeft , xlToRight , xlUp , xlDown


xxxxxxxxxx
Range("A1048576").End(xlUp).offse(1,0).value = "XXX"

'改进当A1单元格为空值
dim c As Range
set c = Range("A1048576").End(xlUp)
if c.value <> "" then
    c.offse(1,0).value = "XXX"
else
    c.value = "XXX"
end if

函数Function、过程Sub

自定义函数、过程

函数可以有一个返回值，但过程没有返回值。
若函数要带返回值，则定义变量名称等于函数名称即可。


xxxxxxxxxx
Sub XXX()
....
End Sub


xxxxxxxxxx
Function Merge(x As String, y As String) As String  '函数包括函数名、参数列表、返回值类型
Merge = x & y   '函数带返回值
End Function


xxxxxxxxxx
Function zmj(x)
zmj = (x / 6.03) - x * 0.03     函数带有返回值
End Function

调用函数、过程

1.VBA内置的函数


xxxxxxxxxx
VBA.Split
Split

2.工作表中的函数


xxxxxxxxxx
Application.WorksheetFunction.CountIf
WorksheetFunction.CountIf

3.调用自定义的函数、过程

第1种：call 函数名（）

第2种：直接函数名

（1）function是函数，sub是子程序，都可以传递参数；

（2）函数允许带一个返回值，过程没有返回值。

（3）若使用call调用，有参数时必须带括号；

若直接调用，参数可不带括号。

1）无参数时


xxxxxxxxxx
Sub test()
call func   ’不能call func()
func        ’不能func()
End Sub

2）有参数时


xxxxxxxxxx
Sub test()
call func1(1,2,3)
func 1,2,3
End Sub

3）函数有返回值,sub没有。

方法：函数名称 = 返回的数据


xxxxxxxxxx
function sum(a,b) as integer
sum = a + b     '带返回值
end function

函数可以有返回值，过程sub不能；Sub只能执行一堆语句而没有返回值。

工作表

1.新建


xxxxxxxxxx
Worksheets.Add      '在活动工作表前插入一张工作表
Worksheets.Add before/after:=Worksheet(5)       '在指定工作前、后插入
Worksheets.Add Count:=3     '插入3张工作表


xxxxxxxxxx
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = "新表名称"
可以简写为：
Sheets.Add (after:=Sheets(Sheets.Count)).Name = "新表名称"
Sheets.Add.Name = "XXXX"

若存在则不建表；若不存在，则新建表并且在1个位置。


xxxxxxxxxx
Function IsSheetResult(shtName)
'''判断Result表是否在，不存在就新建
On Error GoTo A
ThisWorkbook.Sheets(shtName).Activate
Exit Function

A: ThisWorkbook.Sheets.Add(before:=Sheets(1)).Name = shtName
End Function

2.删除


xxxxxxxxxx
Application.DisplayAlerts = False       '关闭提示
Sheets("XXX").delete
Application.DisplayAlerts = True        '开启

3.引用的3种方法


xxxxxxxxxx
Worksheets.Item(3)      '引用第3张工作表
Worksheets(3)           '引用第3张工作表
Worksheets("XXX工作表")  ‘引用XXX工作表
Sheet3.Range("A1")      '代码名称引用工作表，而不需要先写Worksheets

4.获取名称

方法一：


xxxxxxxxxx
Sub SheetsName()
  For i = 1 To Sheets.Count
    Cells(i, 1) = Sheets(i).Name    '表的名称
  Next
End Sub

方法二：


xxxxxxxxxx
Sub ShtName()
    dim sht As Worksheet
    for Each sht in Worksheets
        sht.name    '工作表名称
    Next sht
End Sub

5.修改名称


xxxxxxxxxx
Worksheets(1).Name = "XX工作表"

6.激活工作表


xxxxxxxxxx
Worksheet(3).Activate       '激活
Worksheet(3).Select         ’激活，两者基本无差别
Workbooks(3).ActiveSheet    '选中激活的工作表

7.复制和移动

复制：copy，移动：move


xxxxxxxxxx
Worksheets(1).Copy before/after:=Worksheets(3)  '将第1张工作表复制到第3张工作表之前/后
Worksheets(1).Copy  '复制到新工作薄中去

8.隐藏和显示


xxxxxxxxxx
Worksheets(1).Visible = False       '隐藏
Worksheets(1).Visible = True        ’显示

9.表的数量


xxxxxxxxxx
Worksheets.count    '工作表的数量

10.Sheets和Worksheets区别

Sheets表示工作簿中所有类型的工作表的集合；

Worksheets表示仅有普通工作表的集合。

屏幕刷新和警告对话框

1.屏幕刷新


xxxxxxxxxx
Application.ScreenUpdating = False      '关闭
Application.ScreenUpdating = True       '开启

2.警告对话框


xxxxxxxxxx
Application.DisplayAlerts = False       '关闭
Application.DisplayAlerts = True        '开启

【打开】对话框

1.用FindFile方法

打开在对话框中选中的文件。如果成功打开文件，返回True ；如果取消，返回False 。


xxxxxxxxxx
if Application.FindFile = True then
    MsgBox "已打开文件"
else
    MsgBox "你已取消操作"
End if

2.用GetOpenFilename方法

获得在对话框中选中的文件名称（包含路径）。


xxxxxxxxxx
Application.GetOpenFilename(Filefilter:= "Excel文件,*.xls;*.xlsx")
'可简写为：
Application.GetOpenFilename("Excel文件,*.xls;*.xlsx")

当多种类型文件时，用分号隔开。


xxxxxxxxxx
filePath = Application.GetOpenFilename("Excel文件,*.xls;*.xlsx")
If filePath=False then
    msgbox("没有选中文件")
else
    fileName = mid(filePath,InStrRev(filePath,"\")+1)   
End If

从全路径中提取文件名称


xxxxxxxxxx
'例如
filePath = "C:\Users\Administrator\Desktop\学习笔记\VBA\MyTest.xlsx"
fileName = mid(filePath,InStrRev(filePath,"\")+1)   'MyTest.xlsx

后台打开工作薄并读取数据

要在VB中操作Excel，需要引用Excel对象模型。方法，在菜单里选择[工程] -- [引用]，在窗口里勾选 Microsoft Excel XX.X Object Library 其中，XX.X取决于你安装的Office的版本号。


xxxxxxxxxx
Private Sub Command6_Click()
Dim App As Excel.Application
Dim wb As Excel.Workbook
Dim sht As Excel.Worksheet
'''(1)启动Excel
Set App = CreateObject("Excel.Application")     '引用程序对象实例
App.Visible = False                         '设置Excel为不可见
'''(2)打开文件
Set wb = App.Workbooks.Open("G:\1.XLS")     '工作簿实例
Set sht = wb.Worksheets("Sheet2")           '数据表实例
sht.Range("C1").Value = "你好!"              '设置单元格C1的值为"你好!"
sht.Range("A1").Value = 100                 '设置单元格A1的值为100
sht.Range("A2").Value = 9                   '设置单元格A2的值为9
sht.Range("A3").Value = sht.Range("A1").Value + sht.Range("A2").Value '计算

'''(3)读取数据到变量
x = sht.Range("A2").Value                   ' 把单元格"A2"里的数据读取出来

'''(4)关闭Excel文件,注意下面步骤很重要,不能少!!!
Set sht = Nothing
App.ActiveWorkbook.Close savechanges:=True  '保存对EXCELL进行更改。
Set wb = Nothing
App.Quit
Set App = Nothing
EndSub

2.使用GetObject读取到数组


xxxxxxxxxx
dim path,wb as workbook
path = "E:\VBA\myTestFile.xlsx"
set wb = GetObject(path)
arr = wb.Sheets(1).Range("A1").CurrentRegion
......
set wb = Nothing

Cells、Resize、Offset

cells(行，列)

Cells(行，列)


xxxxxxxxxx
Cells(1, 2)     'B2单元格
Cells(1,"B")
Range(Cells(1, 1), Cells(10, 4))    'A1:D10单元格

行号只能是数字，列可以是数字，也可以是字母（"A"、"B"、"C" ....）。


xxxxxxxxxx
Cells(1,3) = "1,3"
txt = "1,3"
arr = split(txt,",")
Cells(arr(0),arr(1))    '报错，因arr(1)获取到的是字符串类型
Cells(arr(0),arr(1)*1)  '没问题，已转成数字类型

split提取出来的值是字符类型，注意转成数字。

resize(行，列)

（1）resize第一个参数表示扩张后的行数，方向是向下；（2）resize第二个参数表示扩张后的列数，方向是向右；（3）resize以该单元格为起点正整数，不支持0和负数。


xxxxxxxxxx
Range("A1").Resize(1, 4)    'range("A1:A4")
Cells(1,"A").Resize(1, 4)   'range("A1:A4")
Cells(1,1).Resize(1, 4)     'range("A1:A4")
Cells(1, 1).Resize(10, 4).Select        '选中A1:D10单元格
Range(Cells(1, 1), Cells(1, 1).End(xlDown).End(xlToRight)).Select   '选择所有单元格

offset(参考位置 , 行 , 列 , 高 , 宽)

语法：OFFSET(reference,rows,cols,height,width)

offset函数是一个引用函数，表示引用某一个单元格或者区域。

在D3单元格输入公式=OFFSET(A1,2,2,1,1)，其中A1是参考系，接着的2,2分别表示下，右移动的行数和列数，同样向上，左则是负数。最后面的1,1表示引用的区域大小是一行一列，也就是一个单元格。

总结：resize的行列数字只能是正数，不能有负数和0；

offset的行列数字可以正数、负数和0 。

筛选与复制

1.条件筛选并复制


xxxxxxxxxx
Sub CommandButton1_Click()
    Sheets("Tem").Activate      'tem为原始表格
    ActiveSheet.AutoFilterMode = False
    Sheets("Tem").Rows("1:1").Select
    Selection.AutoFilter        '将原始表格设为过滤状态
    Selection.AutoFilter Field:=10, Criteria1:="<1000"      '选择过滤的位置，设定过滤的条件
    Sheets("Tem").Range("a1").CurrentRegion.Select          '选择过滤的内容(选取数据区域)
    Selection.Copy Sheets("Sheet1").Range("a1")             '复制选择的内容到目标表格
    ActiveSheet.AutoFilterMode = True
End Sub

2.自动筛选和复制


xxxxxxxxxx
Set wksData = Sheets("原始表")     '原始表格
Set wksFilter = Sheets("目标表")   '目标表格

'删除已存在的筛选
If wksData.AutoFilterMode = True Then 
    wksData.AutoFilterMode = False
End If
'设为过滤状态，选中行进入自动筛选
wksData.Rows(2).Select
Selection.AutoFilter
'可以简写为
'wksData.rows(2).AutoFilter

'选择过滤的位置，设定过滤的条件,参数17为列号，最多允许同时3个条件
AutoFilter Field:=17, Criteria1:="前厅"

'选取数据区域（选取过滤后的数据区域，有多种方法选取。）
wksData.Range("A1").CurrentRegion.Select

'复制选择的内容到目标表格(注意复制前清空目标表格)
Selection.Copy Sheets("目标表").Range("A1")

'可以简写为：
'wksData.Range("A1").CurrentRegion.Copy wksFilter.Range("A1")

wksData.AutoFilterMode = True

清除内容、格式、公式

清除所有属性和内容
Clear
只清除内容
ClearContents
只清除格式
ClearFormats
只清除批注
ClearComments


xxxxxxxxxx
sheets("XXX").Cells.Clear       '清空整个表格所有内容和属性
range("A1:C8").ClearContents    '只清除值
range("A1:C8").ClearFormats     '只清除样式

字母大小、数字的转换

1.字母与数字

（1）数字转换为字母

数值范围：65～90大写字母；97～122小写字母。 64是@符号


xxxxxxxxxx
Chr(65)     '结果为A

（2）字母转换为数字


xxxxxxxxxx
Asc("A")    '结果为65

2.字母大小写

（1）小写转大写： UCase(string)

（2）大写转小写： LCase(string)

UsedRange与CurrentRegion区别

使用区域：UsedRange

（1）工作表worksheet属性；

（2）当前工作表已经使用的单元格组成的矩形区域。

当前区域：CurrentRegion


xxxxxxxxxx
（1）单元格range属性；

（2）单元格所在的周围以空行和空列隔开的区域。


xxxxxxxxxx
sheets("XXX").UsedRange.select      '前面是工作表
Range("A1").CurrentRegion.select    '前面是单元格

粘贴和选择性粘贴


xxxxxxxxxx
sheet1.range("A3","B8").copy
sheet2.range("A1").pastespecial xlvalues            '只粘贴数值
sheet1.range("A3","B8").copy sheet2.range("A1")     '简写

粘贴Paste
选择性粘贴PasteSpecial
Range对象.PasteSpecial(Paste,Operation,SkipBlanks,Transpose)
参数均为可选。若没有指定参数，则直接复制。
Paste xlPasteType常量，指定复制的具体内容。默认为全部复制。
1. 全部 xlPasteAll
2. 公式 xlPasteFormulas
3. 数值 xlPasteValues
4. 格式 xlPasteFormats
5. 批注 xlPasteComments
6. 验证 xlPasteValidation
7. 所有使用源主题的单元 xlPasteAllUsingSourceTheme
8. 边框除外 xlPasteAllExceptBorders
9. 列宽 xlPasteColumnWidths
10. 公式和数字格式 xlPasteFormulasAndNumberFormats
11. 值和数字格式 xlPasteValuesAndNumberFormats
12. 所有合并条件格式 xlPasteAllMergingConditionalFormats
Operation xlPasteSpecialOperation常量，指明粘贴时要进行的运算操作，即将复制的单元格中的数据与指定单元格区域中的值进行加减乘除运算。
1. 无 xlPasteSpecialOperationNone
2. 加 xlPasteSpecialOperationAdd
3. 减 xlPasteSpecialOperationSubtract
4. 乘 xlPasteSpecialOperationMultiply
5. 除 xlPasteSpecialOperationDivide
SkipBlanks 跳过空单元格
Transpose 转置


xxxxxxxxxx
Range('C2:C4').Copy
'只粘贴格式而不粘贴值
Range('E2').PasteSpecialPaste:=xlPasteFormats
'只粘贴值
Range('F2').PasteSpecialPaste:=xlPasteValues
'粘贴值并保持列宽
Range('C1').PasteSpecialPaste:=xlPasteColumnWidths
Range('C1').PasteSpecialPaste:=xlPasteValues
'将行列转置
Range('C1').PasteSpecialTranspose:=True
'粘贴值并保持列宽
Range('C1').PasteSpecialPaste:=xlPasteColumnWidths
Range('C1').PasteSpecialPaste:=xlPasteValues
Range('A1:A3').Copy Range('C1') '简写

打印 PrintOut/Debug.Print


xxxxxxxxxx
'打印机
Sheets("XXX").printOut Copies:=份数
'仅在立即窗口输出
Debug.Print 内容

模糊查找（是否包含关系）

使用正则表达式： 字符串1 like 字符串2（可用通配符）

常用的： ? 代替一个字符； * 表示多个字符；

例：判断 A1的里面的内容为包含苹果俩字,


xxxxxxxxxx
if cells(1,1).value like "*苹果*"     ‘返回True/False

InStr(字符串,查找字符)
完整语法：instr(起始位置，查找对象，查找目标，比较模式)
返回查找字符在字符串中首次出现的位置；若没找到，则返回0（零）。
```
xxxxxxxxxx
instr("ABCD","C")   '返回3
```

超链接Hyperlinks


xxxxxxxxxx
Expression.Hyperlinks.Add(Anchor, Address, [SubAddress], [ScreenTip], _ [TextToDisplay])

Expression可以是超链接所在的WorkSheet，函数有两个参数是必须的，Anchor是超链接所在的详细区域位置， Address是超链接所要跳转的目标地址。ScreenTip：停留时提示文字；TextToDisplay：超链接的文字

1.跳转到某个网址

直接在Address中写上网址字符串即可。


xxxxxxxxxx
With Worksheets(1) 
 .Hyperlinks.Add Anchor:=.Range("a5"), _ 
 Address:="https://example.microsoft.com",
End With

2.跳转到表格

（1）表格的位置是常量

一般情况下，不使用Address，而是将Address置为空，将目标表格地址放到SubAddress中。


xxxxxxxxxx
ThisWorkbook.Sheets("汇总").Hyperlinks.Add Anchor:=ThisWorkbook.Sheets("汇总").Cells(i, 3), _
            Address:="", _
            SubAddress:="Sheet2!A1"

注意SubAddress的值必须是"Sheet2!A1"才行。

（2）表格的位置是变量


xxxxxxxxxx
       ThisWorkbook.Sheets("汇总").Hyperlinks.Add Anchor:=ThisWorkbook.Sheets("汇总").Cells(i, 3), _
            Address:="", _
            SubAddress:="'" & Variant1 & "'!C" & Variant2

如果跳转的目标位置的Sheet是一个变量，那么将Sheet的名字写到Variant1中即可，如果目标表格的行号是一个变量，那么将行号写到Variant2即可。上图中的代码，点击汇总表的第i行第3列，将会跳转到名称为Variant1的Sheet的第Variant2行，第C列中。

MsgBox

1.基本用法

MsgBox(Prompt[,Buttons][,Title][,Helpfile,Context])

Prompt，必需的参数，为字符串，作为显示在消息框中的消息文本。其最大长度约为1024个字符，由所用字符的宽度决定。如果prompt的内容超过一行，则可以在每一行之间用回车符(Chr(13))、换行符(Chr(10))或是回车与换行符的组合(Chr(13)&Chr(10))将各行分隔开来。

2.Buttons，可选的参数，为数值表达式的值之和，指定显示的按钮的数目及形式、使用的图标样式、缺省按钮及消息框的强制回应等，可以此定制消息框。若省略该参数，则其缺省值为0。设置值见下表。 3.Title，可选的参数，表示在消息框的标题栏中所显示的文本。若省略该参数，则将应用程序名放在标题栏中。 4.Helpfile，可选的参数，为字符串表达式，提供帮助文件。若有Helpfile，则必须有Context。 5.Context，可选的参数，为数值表达式，提供帮助主题。若有Context，则必须有Helpfile。

2.再次确认框


xxxxxxxxxx
If MsgBox("是否删除？", vbYesNo) = vbYes Then
Else
End If

引用单元格

1. 一般使用


xxxxxxxxxx
Range("A1").value = 100
Range("A1:B10","A20:B30").value = 100
Range("A1:B10").Select  '选中单元格'
Cells(2,"D").value = 100
Cells(2,4).value = 100
[A1]   
[A1:A10]

Cells(行号，列标)

使用方括号[ ]时，里面不能使用变量。

所有的行和列


xxxxxxxxxx
sheets("XXX").Rows
sheets("XXX").Cells

单元格的End属性：xlToLeft , xlToRight , xlUp , xlDown

2. 多个区域

（1）并集，在双引号内用逗号分隔


xxxxxxxxxx
Range("A1:A4,B3:D5").select

（2）交集，在字符串内用空格分隔


xxxxxxxxxx
Range("A1:A4 B3:D5").select

（3）矩形区域，在双引号外用逗号分隔


xxxxxxxxxx
Range("A1:A4","B3:D5").select

3. 混合引用


xxxxxxxxxx
Range("A1:E9").cells(2,3).Select        '在A1:E9区域的，第2行与第3行交叉的单元格
Range(Cells(1,1),Cells(10,5)).Select    '选中A1:A10单元格
’相当于下面两行
Range("A1","E10").Select
Range("A1:E10").Select
'索引号引用
Range("B3:F9").cells(8)     '在B3:F9区域中第8个单元格

4. 单元格属性

（1）End属性：xlToLeft , xlToRight , xlUp , xlDown


xxxxxxxxxx
Range("A1048576").End(xlUp).offset(1,0).value = "XXX"

（2）值Value、个数Count、地址Address

（3）Activate、Select

工作簿

1.获取文件信息


xxxxxxxxxx
ThisWorkbook.Name       '名称
ThisWorkbook.Path       '路径
ThisWorkbook.FullName   '路径+名称

2.创建工作簿

1.创建空白工作簿


xxxxxxxxxx
ThisWorkbook.add        'Excel默认空白工作簿

2.将某个工作簿文件作为新建工作簿的模板


xxxxxxxxxx
ThisWorkbook.add Template：="D:\我的文件\模板.xlsm"
ThisWorkbook.add "D:\我的文件\模板.xlsm"

可以省略参数名称Template

3.打开open和关闭close

（1）打开时，必须是全路径（路径 + 文件名）


xxxxxxxxxx
Workbooks.Open Filename:="D:\XXX\ABC.xlsm"
Workbooks.Open "D:\XXX\ABC.xlsm"        ’简写


xxxxxxxxxx
FilePath="D:\我的文件\模板.xlsm"
Workbooks.Open（FilePath）

（2）关闭


xxxxxxxxxx
Workbooks.Close             '关闭当前打开的所有工作簿（仅仅关闭，但不能退出Excel文件）
Workbooks("XXXX").Close     '关闭名称为XXXX工作簿'
Workbooks("XXXX").Close savechange:=True    '关闭并保存
Workbooks("XXXX").Close True                '简写


xxxxxxxxxx
'从全路径中提取文件名称
filePath = "C:\Users\Administrator\Desktop\学习笔记\VBA\MyTest.xlsx"
fileName = mid(filePath,InStrRev(filePath,"\")+1)   'MyTest.xlsx

（3）关闭窗体和Excel文件

UserFrom的事件：Terminate、Querylose


xxxxxxxxxx
Application.DisplayAlerts=False         '关闭提醒
ThisWorkbook.Saved = False              '不保存，True保存
Application.Quit                        '退出Excel文件

4.保存和另存文件


xxxxxxxxxx
ThisWorkbook.Save       '保存代码所在的工作簿'
ThisWorkbook.SaveAs FileName:="D:\Test.xlsm"    '另存文件后自动打开
ThisWorkbook.SaveCopyAs FileName:="D:\Test.xlsm"    '另存文件后不打开

如果省略路径，默认保存在当前文件夹中。

5.激活Activate/当前工作薄


xxxxxxxxxx
Workbooks("工作簿1").Activate    '激活工作簿
activeWorkbook.name             '要选活动工作簿

Dim wk as Workbook
set wk = Thisworkbook                   '当前工作薄

6.最小化


xxxxxxxxxx
Sub 最小化工作簿()
    Dim BOOK As Workbook
    B = InputBox("写入工作簿名称")
    Set BOOK = Workbooks(B)
    BOOK.Activate
    ActiveWindow.WindowState = xlMinimized
    Set BOOK = Nothing
End Sub

7.判断是否打开

有没有不用遍历所有打开的工作簿就能知道工作簿是否打开呢？就好比在一群人中找到姓名为张三的小伙伴，是通过在一群人中一个一个去问，还是通过广播直接找张三呢。谁快谁慢，相必大家了然于胸，那VBA代码该如何去写呢？详细代码如下所示：

方法一（报错，更快些）


xxxxxxxxxx
Function IsWbOpen2(strName As String) As Boolean
   On Error Resume Next
   Dim wk As Object
   '如果工作簿没打开，直接赋值会报错，故使用On Error Resume Next
   Set wk = Workbooks(strName)
   If Err.Number = 0 Then       '或者Err.Number=9 是未打开，报错
       IsWbOpen2 = True
   Else
       IsWbOpen2 = False    
   End If
End Function

方法二（遍历）


xxxxxxxxxx
Function IsWbOpen1(strName As String) As Boolean
  '如果目标工作簿已打开则返回TRUE，否则返回FALSE
  Dim i As Long
  For i = Workbooks.Count To 1 Step -1
      If Workbooks(i).Name = strName Then
          Exit For
      End If
  Next
  If i = 0 Then
      IsWbOpen1 = False
  Else
      IsWbOpen1 = True
  End If
End Function

Workbooks下标越界，提取文件名称

Workbooks表示当前所有打开的工作薄的对象集合，与sheets用法一样。

workbooks带上路径就出错，下标越界，只写文件名就没有问题;

解决：取得最右边“\”的右边部分，也就是文件名称。


xxxxxxxxxx
workbooks（“f:\vba\aaa.xlsx”）    '报错，下标越界
workbooks（"aaa.xlsx"）           '没有问题


xxxxxxxxxx
myfile="f:\vba\aaa.xlsx"
if instr(myfile,"\")>1 then mid(myfile,instrrev(myfile,"\")+1)  '从全路径中提取出aaa.xlsx
workbooks(myfile)       '不会下标越界

判断单元格是否为空

（1）IsEmpty()函数

空为True，否则为False

（2）其它方法


xxxxxxxxxx
range("A1")=""
len(range("A1"))=0
range("A1")=vbNullString
len(trim(range("A1")))=0    '防止有空格

判断数据类型

（1）isdate函数

判断一个数据是否为日期类型；是，返回true；不是，返回false

（2）isnumeric函数

判断一个数据是否为数值类型（integer、long、single、double、currency等）。返回True/False
与Application.isnumber（）的区别
- 执行结果和写法都比较相似，但isnumeric的结果更精确。
  例如日期变量1/2/2019，公式isnumber返回的结果为True，因为日期本质上也是数值；而Application.isnumeric返回的结果为False。
- Application.isnumber（）只有纯数字返回True；isnumeric是纯数字或者纯数字的字符串都返回True。
```
xxxxxxxxxx
a = "123"
Application.isnumber(a) '返回 False
isnumeric(a)            '返回 True
```

（3）并不是每一个数据类型都有对应的数据类型判断函数

stringt和boolean没有函数

（4）typename函数

返回数据的类型名称。

如typename(8)，返回字符串“Integer”。注意返回的数据类型的字符串中首字母是大写的。

日期和时间

三个无参数函数：Date、Time、Now，分别返回当前电脑系统的日期、时间、日期+时间

单元格设置成文本格式


xxxxxxxxxx
range("A1").NumberFormatLocal = "G/通用格式"
range("A1").NumberFormatLocal = "@"
range("A1:A65536").NumberFormatLocal = "@"

内置函数

1.使用方法

VBA中有许多内置函数，但要使用工作表中函数，Application对象的WorksheetFuntion属性。

例：统计A1:B10单元格中大于100的个数


xxxxxxxxxx
Application.WorksheetFuntion.CountIf("A1:B10",">100")

2.常见内置函数

MsgBox
InputBox
舍入函数：Fix 向0取整, Int向下取整, Round四舍五入
Rnd：返回0-1内的单精度随机数
mid：字符串函数
Filter：对字符串的一维数组的过滤
InStr([Start, ],[, Compare])与InStrRev：查找子串
Len：字符串长度

Join：与split完全相反；连接一维数组中的所有子字符串,默认空白（“ ”），


xxxxxxxxxx
a = Array("A", "B", "C")
Range("A1")=Join(a)      '默认空白，返回 A B C
Range("A1")=Join(a,",")  '逗号连接，返回 A,B,C

Left,Right,Mid：截取子字符串
Space(数值) ：生成空格字符串
Ucase,Lcase：大小写转换函数
Ltrim, Rtrim,Trim ：删除首尾空格
Replace()：替换
Split：分割一个字符串成为一维数组
StrComp：字符串比较
StrConv：字符串转换
String(number, character)：制定字符重复若干次

用户窗体设计

修改显示的文字（名称）

1.caption是显示在窗体中给用户看的；

2.（名称）是代码中识别要操作的窗口；


xxxxxxxxxx
Sub ShowForm()
    load InputForm      '加载InputForm窗体'
    InputForm.show      '显示InputForm窗体'
    unload InputForm    '关闭InputForm窗体'
    InputForm.hide      '隐藏InputForm窗体'
End Sub

如果在调用窗体的Show方法前窗体没有加载，Excel会自动加载。

3.UserForm借助initialize事件初始化窗体


xxxxxxxxxx
Privatesub Sub 窗体_Initialize()
    性别.List=Array("男","女")  '添加性别复合框选项
End Sub

4.打开Excel就自动打开窗体

选择ThisWorkbook→Workbook～open事件


xxxxxxxxxx
Privatesub Sub Workbook_open()
    Application.Visible = False '隐藏Excel程序界面'
    denglu.show vbModal         '显示denglu窗体,可省略vbModal
    denglu.show                 '与前带参vbModal一样，模式窗体
    denglu.show vbModeless      '无模式窗体
End Sub

模式窗体是指不能执行窗体之外的对象。

禁用窗体中的【关闭】按钮


xxxxxxxxxx
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = vbFormControlMenu Then Cancel = True
  '或者If CloseMode =0 Then Cancel = True
End Sub

关闭窗体和Excel文件

1.窗体内按钮的单击事件


xxxxxxxxxx
Private Sub Btn_Click()
  Application.DisplayAlerts = False '不显示自动提示和警告。你传的图片就是因为没这句所以Excel才提示。
  ThisWorkbook.Saved = True         '保存工作簿（看需要）
  Unload Me                         '关闭窗体
  Application.Quit                  '关闭Excel
End Sub

2.用户窗体的 Terminate 事件中


xxxxxxxxxx
Private Sub UserForm_Terminate()
    ThisWorkbook.Saved = True
    Application.Quit
End Sub

双击单元格事件

1.选择“Worksheet”中的“BeforeDoubleClick”事件

2.利用If指定执行代码的单元格；

3.设置Cancel=True，利用Call执行宏。


xxxxxxxxxx
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$A$1" Then
        MsgBox "你好啊，你双击的单元格是" & Target.Address, 48, " 明白了吗？"
    End If
End Sub

获取窗体控件内容（值）


xxxxxxxxxx
AA窗体.show vbModeless             '打开窗体，无模式窗体
XXX控件名称.value                   '在窗体中可直接:XXX控件名称.value
AA窗体("XXX控件名称").value          '在sheet表中使用时，窗体与Sheet同级，类似Sheets("Sheet1")

列表框

1.常用功能


xxxxxxxxxx
With ListBox1
    .AddItem "XXX"      '添加
    .RemoveItem i       '删除索引为i的行
    .Clear              '清空
    .ListIndex          '当前选择的索引号（行号），从0开始
    .List(i)            '当前索引行的值，多列为(行，列) 例如：List(1,2) 这是第1行第2列值
    .list = arr         '数组对列表赋值，仅一列为一维，若多列为二维。
    .ColumnCount = 6    '设置为6列
    .ListCount          '总行数
    .RowSoure = "Sheet2!A1:D10"     '指定数据源，字符串属性
    .ColumnHeads = True     '设置标题
    .ColumnWidths = "30;30;30"  ’设置列宽，单位为磅
    .TextAlign                  '文字位置，左，中，右
End With

参数详解

（1）ListBox1.ListCount '列表总行数

（2）ListBox1.ListIndex '返回当前选中的列表的行数，从0开始，0是第一行

（3）ListBox1.Selected(i) = True

'判断列表第几行是否被选定，值为True时是选定，False没选定,变量“i”是索引值，从0开始，0是第一行

（4）ListBox1.MultiSelect = 1

'0或fmMultiSelectSingle不允许多项选择,1或fmMultiSelectMulti,简单的多项选择,即用鼠标单击或用空格键光标键操作,2或fmMultiSelectExtended 扩充多项选择,即用Shift键和Ctrl键配合操作,可手动在列表属性框提前设置好，或在窗体初始化时加载代码，总之要在使用前生效

（5）ListBox1.List(i) '返回当前行的值，这是单列的，如果是多列ListBox1.List(行，列)

（6）ListBox1.Liststyle=0

'列表风格，可多选时有效，0是标准风格，值为1时，前每项前加一个小方框，选择时打上勾。

（7）ListBox1.ColumnCount = 6 '把列表框设为6列

（8）ListBox1.RowSource = "A1:F5" '把当前表格A1:F5内容显示在列表框中，列表框要选择设置好列数

（9）ListBox1.ControlSource = "A6"

'表格上的A6不能已经使用,不然会报错，把列表框当前选择的某一值在单元格A6中显示，这个值通过BoundColumn指定列加上选择的行数选择。

（10）ListBox1.BoundColumn = 0

'值为0是把当前选择的行数索引号（从0开始）返回到ControlSource参数指定的单元格，值为大于0的整数，则把相应列的选择行对应的值显示在ControlSource参数指定的单元格

（11）ControlTipText = “把鼠标移动当前控件上的时候显示的提示文字”

举例

（1）列表框可多选时，反选的方法


xxxxxxxxxx
Private Sub 反选_Click()
    If ListBox1.ListCount < 1 Then
        MsgBox "请先获取数据表字段"
        Exit Sub
    End If
    Dim i As Integer
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            ListBox1.Selected(i) = False
        Else
            ListBox1.Selected(i) = True
        End If
    Next
End Sub

（2）列表框可多选时，全选的方法


xxxxxxxxxx
Private Sub 全选_Click()
    Dim i As Integer
    If ListBox1.ListCount < 1 Then
        MsgBox "请先获取数据表字段"
        Exit Sub
    End If
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = True
    Next
End Sub

（3）列表框可多选时，重置选择的方法


xxxxxxxxxx
Private Sub 重置_Click()
    If ListBox1.ListCount < 1 Then
        MsgBox "请先获取数据表字段"
        Exit Sub
    End If
    Dim i As Integer
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
    Next
End Sub

（4）显示多列数据


xxxxxxxxxx
Sub 列表框()
    Dim arr,EndRow
    EndRow = Sheets("XXX").[A65536].End(xlUP).Row
    arr = Sheets("XXX").Range("A1:E" & EndRow)
    With ListBox1
        .ColumnCount = 5    '设置列表为5列
        .Lsit = arr         '数据源，多列时为二维
        
        .TextAlign = fmTextAlignCenter '设置居中显示
        .ColumnWidths = "48磅;48磅;48磅;48磅;48磅" '设置列宽，设置多列用分号;隔开
        .ColumnHeads = False    '不显示表头
        .RowSoure = "Sheet2!A1:D10" '指定数据源，字符串属性
    End With
End Sub

2.列表框添加数据三种方法

（1）使用RowSource属性

这是一个字符串属性，而不是单元格区域


xxxxxxxxxx
.RowSoure = range("Names").Address  'Names指Excel命名区域

（2）使用List属性或Column属性

List(行，列) Column(列，行)


xxxxxxxxxx
.List = Range("Names").value

（3）Additem方法

此方法在列表中添加一行，并且只能放置一个新值在第一列中；在多列时，需要使用List或Columnn属性放置新置。


xxxxxxxxxx
With ListBox
    .Additem
    .List(0,0) = "AAA"
    .list(0,0) = "BBB"
End With

VBA中常见对象

对象	说明
Application	应用程序
Workbook	工作簿
Worksheet	工作表
Range	单元格

获取文件夹下的所有文件名和修改日期

关键点：若要包含文件夹，则带上vbDirectory参数。


xxxxxxxxxx
file = Dir(path & "*.*",vbDirectory)
Do While file <> ""
    ......
    file = Dir  '一定要写， 不然死循环
    i = i +1
Loop

实例详细：


xxxxxxxxxx
Sub FileTest() 
    '获取文件名和修改日期
    Dim path, file, i
    path = Application.ThisWorkbook.path & "\"
    '只是文件名 不是文件对象
    file = Dir(path & "*.*")    
    ’file = Dir(path & "*.*",vbDirectory)   ’若要包含文件夹，则带上vbDirectory参数。
    With ThisWorkbook.Worksheets(1)
        .Cells(1, 1) = "文件名"
        .Cells(1, 2) = "修改日期"
        i = 2
        Do While file <> ""     'And file <> ThisWorkbook.Name 本程序所在文件
            .Cells(i, 1) = file
            .Cells(i, 2) = FileDateTime(path & file)
            i = i + 1
            file = Dir  '一定要写， 不然死循环
        Loop
    End With
    '设置时间格式和自动适应列宽
    Columns("B:B").NumberFormatLocal = "yyy-mm-dd hh:mm:ss"
    Columns("A:B").AutoFit
End Sub

Dir函数

1.返回一个文件夹下一个文件的名字（包含后缀）


xxxxxxxxxx
filename = Dir("F:\userdata\Desktop\新建文件夹\")

（1）dir后面的参数应该以反斜杠“\”结尾，这样才能返回该文件夹下的文件名称。否则“新建文件夹”会被当成一个文件名进行处理。

（2）Dir运行一次只能得到一个文件名。为得到下一个文件名，代码应该这样写：filename = Dir

（3）Dir后面不写任何参数，如果写了与前面相同的参数"F:\userdata\Desktop\新建文件夹"，则会重新扫描该文件夹，又得到第一个文件名，如果更改为其他文件夹，就扫描该文件夹，得到它的第一个文件名。

（4）如果文件夹中有n个文件，或者说有n个符合条件的文件，那么当Dir运行第n+1次时，则返回一个空字符串，代表已经查找完所有的文件。Dir运行第n+2次时，程序将报错。

扫描一个文件夹下所有文件的通用模板


xxxxxxxxxx
Dim filename as string
filename = Dir("F:\userdata\Desktop\新建文件夹\")  '可以更改为任意文件夹
Do while filename <> ""
    相关操作
    filename = Dir  '获取下一个文件名
Loop

Dir扫描符合条件的文件名（通配符*)

示例：扫描所有后缀为.xls的文件。


xxxxxxxxxx
F = Dir("F:\userdata\Desktop\新建文件夹\*.xls")

判断一个文件是否存在


xxxxxxxxxx
F = Dir("F:\userdata\Desktop\新建文件夹\123.xls")

如果文件123.xls存在，则返回字符串123.xls，如果不存在，则返回空字符串。

扫描文件和子文件夹名称
（1）一般情况下，Dir函数只返回文件名，而不返回子文件夹名。如果想要两者都返回，则需要加上vbDirectory参数。示例代码如下：
```
xxxxxxxxxx
F = Dir("F:\userdata\Desktop\新建文件夹\" , vbDirectory)
```
（2）特别要注意的是，子文件夹包括“.”和“..”两个特殊名字，分别代表本目录F:\userdata\Desktop\新建文件夹\及其父目录F:\userdata\Desktop\。
（3）Dir函数只能返回第一层的子文件夹和文件名，子文件夹下的文件与文件夹不返回。

去重复项RemoveDuplicates


xxxxxxxxxx
ActiveSheet.Range("A21:E36").RemoveDuplicates Columns:=5, Header:=xlYes

其中Columns参数指定要删除重复项的列，如果是1的话，那么第一列中重复项所在行都会被删除，如果是2则只有1,2两列均重复的行才会被删除，以此类推，你的区域5列，那么只有5列均重复的行会被删除。

如果想在1,2列中只根据某几列的重复来删除，比如，1 3 5列。那么参数写为Columns:=Array(1,3,5)

案例：仅根据第1列重复项删除整行


xxxxxxxxxx
Option Explicit
Option Compare Text
Sub 去重()
    Dim sSheet As Worksheet
    Set sSheet = ActiveSheet
    sSheet.Range("A1:A25").EntireRow.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub


xxxxxxxxxx
Option Explicit
Option Compare Text
Sub 去重()
    Dim sSheet As Worksheet
    Set sSheet = ActiveSheet
    sSheet.Range("A1:H25").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

总结：

1）去重时忽略大小写；

2）前或后带空格的项却不做为重复项，无法去重，见上面案例。----- 关于这一点，经验验证：WPS 2019 --- 数据 --- 删除重复项也是无法去除的，因此RemoveDuplicates 方法和工具菜单的方式去重是一样的效果。