VBA基础知识整理（事件，数组）
事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MsgBox "单元格选择发生了改变"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ’取消事件级联
Target = Target * 2
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Calculate()
MsgBox "公式的值发生了改变"
End Sub
Private Sub Worksheet_Calculate()
MsgBox "公式的值发生了改变"
End Sub
程序事件
Public WithEvents app As Excel.Application
-----------------------------------------------------------------
Private Sub Workbook_Open()
Set app = Excel.Application
End Sub
-----------------------------------------------------
Private Sub app_WorkbookOpen(ByVal Wb As Workbook)
' a = Application.InputBox("请输入打开excel程序口令", "安全提示")
' If a <> 123 Then
' Wb.Close False
' End If
End Sub
VBA数组
数组与单元格的区别，数组更快
Sub v4() '运行时间0.01秒
Dim t
t = Timer
For x = 1 To 100000
m = m + 1000 '真接调用内存中的值
Next x
MsgBox Timer - t
End Sub
--------------------------------------------------
Sub v5() '运行时间0.5秒
Dim t
t = Timer
For x = 1 To 100000
m = m + Cells(1, 1) '调用单元格中的值
Next x
MsgBox Timer - t
End Sub
----------------------------------------
'1、什么是VBA数组呢？
'VBA数组就是储存一组数据的数据空间?数据类型可以数字,可以是文本,可以是对象,也可以是VBA数组.
'2 VBA数组存在形态
' VBA数组是以变量形式存放的一个空间,它也有行有列，也可以是三维空间。
'1) 常量数组
'array(1,2)
'array(array(1,2,4),array("a","b","c"))
'2) 静态数组
'x(4) '有5个位置，编号从0~4
'arr(1 to 10) '有10个位置，编号1~10
'arr(1 to 10,1 to 2) '10行2列的空间，总共20个位置，这是二维数组
'arr(1 to 10,1 to 2,1 to 3) '三维数组，总10*2*3=60个位置。这是三维数组
'3)动态数组
'arr() '不知道有多少行多少列
'向VBA数组中写入数据
1、按编号(标)写入和读取
Sub t1() '写入一维数组
Dim x As Integer
Dim arr(1 To 10) '下标从1开始，默认从0开始
arr(2) = 190
arr(10) = 5
End Sub
Sub t2() '向二维数组写入数据和读取
Dim x As Integer, y As Integer
Dim arr(1 To 5, 1 To 4)
For x = 1 To 5 '行
For y = 1 To 4 '列
arr(x, y) = Cells(x, y)
Next y
Next x
MsgBox arr(3, 1)
End Sub
'2、动态数组
Sub t3()
Dim arr()
Dim row
row = Sheets("sheet2").Range("a65536").End(xlUp).row - 1
ReDim arr(1 To row) ’得重新定义
For x = 1 To row
arr(x) = Cells(x, 1)
Next x
Stop
End Sub
'3、批量写入
Sub t4() '由常量数组导入
Dim arr
arr = Array(1, 2, 3, "a")
Stop
End Sub
Sub t5() '由单元格区域导入
Dim arr
arr = Range("a1:d5")
End Sub
'VBA数组读取
Application.Transpose(arr1)
'1、在内存中读取
'在内存中读取后用于继续运算，直接用下面的格式
'数组变量(5) '一维数组
'数组变量(3,2) '二维数组
'例:
Sub d1()
Dim arr, arr1()
Dim x As Integer, k As Integer, m As Integer
arr = Range("a1:a10") '把单元格区域导入内存数组中
m = Application.CountIf(Range("a1:a10"), ">10") '计算大于10的个数
ReDim arr1(1 To m)
For x = 1 To 10
If arr(x, 1) > 10 Then '如果成立，就把二维数组写入arr1数组
k = k + 1
arr1(k) = arr(x, 1)
End If
Next x
End Sub
-------------------------------------------------
'2、读取存入单元格中
Sub d2() '二维数组存入单元格
Dim arr, arr1(1 To 5, 1 To 1)
Dim x As Integer
arr = Range("b2:c6") ‘下标从1开始
For x = 1 To 5
arr1(x, 1) = arr(x, 1) * arr(x, 2)
Next x
Range("d2").Resize(10) = arr1
End Sub
------------------------------------------------------------
Sub d3() '一维数组存入单元格
Dim arr, arr1(1 To 5)
Dim x As Integer
arr = Range("b2:c6")
For x = 1 To 5
arr1(x) = arr(x, 1) * arr(x, 2)
Next x
'Range("a13").Resize(1, 5) = arr1
Range("d2").Resize(5) = Application.Transpose(arr1) ‘行变成列
End Sub
-----------------------------------------------------------
Sub d4() '数组部分存入
Dim arr, arr1(1 To 10000, 1 To 1)
Dim x As Integer
arr = Range("b2:c6")
For x = 1 To 5
arr1(x, 1) = arr(x, 1) * arr(x, 2)
Next x
Range("d2").Resize(5) = arr1
End Sub
数组的大小
'1、数组的大小
'数组是用编号排序的，那么如何获得一个数组的大小呢
'Lbound(数组) 可以获取数组的最小下标(编号)
'Ubound(数组) 可以获取数组的最大下标(编号)
'Ubound(数组,1) 可以获得数组的行方面(第1维)最大下标
'Ubound(数组,2) 可以获得数组的列方向(第2维)的最大下标
Sub d6()
Dim arr
Dim k, m
arr = Range("a2:d5")
For x = 1 To UBound(arr, 1) '数组第一维:行
Next x
End Sub
'2、动态数组的动态扩充
'如果一个数组无法或不方便计算出总的大小，而在一些特殊情况下又不允许有空位。这时我们就需要用动态的导入方法
'
'ReDim Preserve arr() 可以声明一个动态大小的数组，而且可以保留原来的数值，就相当于厂房小了，可以改扩建增大，但是它只能
'让最未维实现动态，如果是一维不存在最未维，只有一维
例子1见sheet1工作表
Sub d7()
Dim arr, arr1()
Dim x, k
arr = Range("a1:d6")
For x = 1 To UBound(arr) ‘第一维，行
If arr(x, 1) = "B" Then
k = k + 1
ReDim Preserve arr1(1 To 4, 1 To k)
arr1(1, k) = arr(x, 1)
arr1(2, k) = arr(x, 2)
arr1(3, k) = arr(x, 3)
arr1(4, k) = arr(x, 4)
End If
Next x
Range("a8").Resize(k, 4) = Application.Transpose(arr1)
End Sub
Sub d8()
Dim arr, arr1(1 To 100000, 1 To 4)
arr = Range("a1:d6")
Dim x, k
For x = 1 To UBound(arr)
If arr(x, 1) = "B" Then
k = k + 1
arr1(k, 1) = arr(x, 1)
arr1(k, 2) = arr(x, 2)
arr1(k, 3) = arr(x, 3)
arr1(k, 4) = arr(x, 4)
End If
Next x
Range("a15").Resize(k, 4) = arr1
End Sub
'3 清空数组
'清空数组使用earse语句
Sub d9()
Dim arr, arr1(1 To 1000, 1 To 1)
Dim x, m, k
arr = Range("a1:a16")
For x = 1 To UBound(arr)
If arr(x, 1) <> "" Then
k = k + 1
arr1(k, 1) = arr(x, 1)
Else
m = m + 1
Range("c1").Offset(0, m).Resize(k) = arr1
Erase arr1
k = 0
End If
Next x
End Sub
可以生成数组的函数
’ 1、split函数
'按分隔符把字符串截取成VBA数组,该数组是一维数组，编号从0开始
'split(字符串,分隔符)
Sub t1()
Dim sr, arr
sr = "A-BC-FGR-H"
arr = VBA.Split(sr, "-")
MsgBox Join(arr, ",")
End Sub
’ 2、Filter函数：
'按条件筛选符合条件的值组成一个新的数组
'Filter(数组,筛选条件,是/否)
'注：如果是（true）则返回包含的数组，如果否则返回非包含的数组，下标从0开始
Sub t2()
Dim arr, arr1, arr2
arr = Application.Transpose(Range("A2:A10"))
arr1 = VBA.Filter(arr, "W", True)
arr2 = VBA.Filter(arr, "W", False)
Range("B2").Resize(UBound(arr1) + 1) = Application.Transpose(arr1)
Range("C2").Resize(UBound(arr2) + 1) = Application.Transpose(arr2)
End Sub
'3、index函数：
'调用该工作表函数可以把二维数组的某一列或某一行截取出来，构成一个新的数组。
INDEX(array,row-num,column-num)
array:要返回值的单元格区域或数组
row-num:返回值所在的行号
column-num:返回值所在的列号
MATCH函数可以返回指定内容所在的位置，而INDEX又可以根据指定位置查询到位置所对应的数据
=MATCH(C9,A1:A6,0)
第1个参数是需要在数据表中查找的值，C9，即“差旅费”；
第2个参数是可能包含所要查找的数据的连续单元格区域，即A1：A6；
第3个参数是查询的指定方式，默认为0，精确查找
最终我们得到4
' Application.Index(二维数组,0,列数)) 返回二维数组
' Application.Index(二维数组,行数,0)) 返回一维数组
Sub t3()
Dim arr, arr1, arr2
arr = Range("a2:d6")
arr1 = Application.Index(arr, , 1)
arr2 = Application.Index(arr, 4, 0)
Stop
End Sub
'4、vlookup函数 查找/索引函数
'Vlookup函数的第一个参数可以用VBA数组，返回的也是一个VBA数组
VLOOKUP(lookup_value, table_array, col_index_num, [range_lookup])
VLOOKUP(查询值,数据源,显示序列,匹配参数)
lookup_value，这是第一参数，表示需要查找的内容。
table_array，这是第二参数，表示的是你要从中匹配查找并返回结果的数据区域。
[range_lookup] ，函数第四个参数有两种：FALSE/0为精确查找，TRUE/1为模糊匹配
Sub t4()
Dim arr, arr1
arr = Range("a2:d6") '数组下标从1开始
arr1 = Application.VLookup(Array("B", "C"), arr, 4, 0) ’返回数组
End Sub
'5 Sumif函数和
Countif函数
'Countif和sumif函数的第二个参数都可以使用数组，所以也可以返回一个VBA数组，如：
sumif(range，criteria，sum_range)
Sumif（条件区域，求和条件，实际求和区域）
Application.WorksheetFunction.sumif
Sub t5()
Dim T
T = Timer
Dim arr
arr = Application.SumIf(Range("a2:a10000"), Array("B", "C", "G", "R"), Range("B2:B10000"))
MsgBox Timer - T
End Sub
-------------------------------------------------------------------------
Sub t55()
Dim T
T = Timer
Dim arr, arr1(1 To 4, 1 To 2), x
arr1(1, 1) = "B"
arr1(2, 1) = "C"
arr1(3, 1) = "G"
arr1(4, 1) = "R"
' arr = Range("a1:d10000")
For x = 2 To 10000
Select Case Cells(x, 1)
Case "B"
arr1(1, 2) = arr1(1, 2) + Cells(x, 2)
Case "C"
arr1(2, 2) = arr1(2, 2) + Cells(x, 2)
Case "G"
arr1(3, 2) = arr1(3, 2) + Cells(x, 2)
Case "R"
arr1(4, 2) = arr1(4, 2) + Cells(x, 2)
End Select
Next x
MsgBox Timer - T
End Sub
数组的处理
’
'1 数组的最值
Sub s()
Dim arr1()
arr1 = Array(1, 12, 4, 5, 19)
MsgBox "1, 12, 4, 5, 19最大值" & Application.Max(arr1)
MsgBox "1, 12, 4, 5, 19最小值:" & Application.Min(arr1)
MsgBox "1, 12, 4, 5, 19第二大值：" & Application.Large(arr1, 2)
MsgBox "1, 12, 4, 5, 19第二小值：" & Application.Small(arr1, 2)
End Sub
'2、求和
'用application.Sum (数组)
'3 统计个数
'count和counta函数可以统计VBA数组的数字个数及所有已填充内容的个数
Sub s1()
Dim arr1, arr2(0 To 10), x
arr1 = Array("a", "3", "", 4, 6)
For x = 0 To 4
arr2(x) = arr1(x)
Next x
MsgBox "数组1的数字个数：" & Application.Count(arr1) ' 数字个数
MsgBox "数组2的已填充数值的个数" & Application.CountA(arr2)
End Sub
'3 在数组里查找
Sub s2()
Dim arr
On Error Resume Next
arr = Array("a", "c", "b", "f", "d")
MsgBox Application.Match("f", arr, 0)
If Err.Number = 13 Then
MsgBox "查找不到"
End If
End Sub
集合
Dim coll As Collection
Set coll = New Collection
coll.Add
coll.Count
coll.Item
coll.Remove
Range("a1:c1") = 1
Range("a1:a3") = Application.Transpose(Range("a1:c1"))