VBA数组

定义数组

• 固定宽度数组

'在声明数组时，必须指定数组上界索引号，下界索引号没有指定，则默认为0。
'所以：dim arr(10) 与 dim arr(0 to 10) 实际效果是一样的，arr上界索引都是0，数组从0-10
dim arr(10) as Integer

'该数组指定了下界索引为1，如果没有指定数组数据类型，则默认为变体型变量：Variant，可以赋值各种类型数据。
dim arr(1 to 10)

'定义二维数组：10行*2列
dim arr(1 to 10,1 to 2)

'将字符串‘第二行第一列’赋值给数组arr
arr(2,1) = "第二行第一列"

• 动态数组

dim arr
'将区域单元格的值赋值给arr
'数组的上标是从arr(1,1)开始的。注意：arr(1,1)的值是range("a3")的值，即单元格区域左上角值为arr(1,1)。
arr = range("a3:c10")

'不知道数组空间多大的情况下，先这么定义，假设需要一维数组。
dim arr()
'有一个数据符合条件,重新redim定义数组，将其赋值给数组。
redim arr(1 to 1) 
arr(1) = "第一个数据"

'现在发现了第二个符合条件的数据，需要先重新定义数组大小，再赋值。
'这里需要注意，重新定义数据，如果不想丢失之前赋值的数组内容，需要在定义时使用‘preserve’关键字。
redim preserve arr(1 to 2)
'赋值
arr(2) = "第二个数据"

---

获取数组的上下标

dim arr
arr = range("a1:c10")
'获取上标，我们可以知道数组的形状大小。
ubound(arr)		'数组行的上标，这里是10，一共有10行。
ubound(arr,2)		'数组列的上标，指定第二个参数为‘2’是获取列的上标，这里是3，a列到c列一共是3列。

'获取下标
'一般是1，没什么意义，当然如果是dim arr(10),这样下标是0。
lbound(arr)
lbound(arr,2)

---

可能用到的函数&方法

• 数组也可以使用工作表一些函数，比如：

1. sum：求和

'对数组数据求和
Application.WorksheetFunction.Sum(arr)

2. index：截取数组某行或者某列

'定义10行10列数组
dim arr(1 to 10,1 to 10)
'这里需要注意的是，index第二个或第三个参数，必须有一个为0，只能截取某行或者某列。
'截取第二列，第三个参数表示截取哪一列。
Application.WorksheetFuncion.Index(arr,0,2)
'截取第三行，第二个参数表示截取哪一行。
Application.WorksheetFuncion.Index(arr,3,0)

3. join：使用指定字符串拼接数组

arr = array("姓名","年龄")
'使用下划线将数组连接起来，类似sql的concat函数。
st = join(arr,"_")
'输出：姓名_年龄

5. 清空数组

'有时候我们并不需要该数组了，为节省内存空间，可以清空数组。
Erase arr

---

数组写入到单元格

'定义一个一个10行5列数组。
dim arr(1 to 10,1 to 5)
dim rg as range
dim i as Byte
'for each 循环只能用变体型变量，这也是一个需要注意的地方
dim each_arr

i = 1
'对数组进行连续整数赋值
for each each_arr in arr
	each_arr = i
	i = i + 1
next

'使用with语句，可以省去部分代码量。不用再重复引用activesheet，直接在‘.’后面使用with对象的属性或方法即可。
with activesheet
	set rg = .range("a1").resize(10,5)
	'resize用于表示单元格范围，第一个参数表示以起点单元格a1为始的行数，第二个表示列数，数组是10行5列的。
	 rg = arr
	
	'清除单元格内容
	rg.clearcontents
	'将第三列数组数据写入到单元格
	.range("a1").resize(10,1) = application.worksheetfunction.index(arr,0,3)

	rg.clearcontents
	'将第五行数组数据写入到单元格
	.range("a1").resize(1,5) = application.worksheetfunction.index(arr,1,0)
	'注意，如果单元格的长度不够数组长度，则会从数组下标开始截取单元格长度填充内容到单元格。
	.range("a1").resize(1,3) = application.worksheetfunction.index(arr,1,0)
	
	rg.clearcontents
	'将第五行数组数据纵向写入到单元格，使用工作表函数：transpose数组转置
	.range("a1").resize(5,1) = application.worksheetfunction.transpose(application.worksheetfunction.index(arr,1,0))
	
	'数组写入到单元格不需要了，清空。
	Erase arr
end with

---

数组筛选代码示例：

数据源：
地区 |水果 |销量
广东 |苹果 | 1
湖南 |苹果 | 2
海南 |椰子 | 6
湖南 |苹果 | 5
河北 |柿子 | 7
湖南 |橘子 | 4

Sub arr_autofiter()
'关闭屏幕更新
Application.ScreenUpdating = False
'关闭自动重算
Application.Calculation = xlCalculationManual
Dim arr(), brr
Dim i, r As Long
r = 1

With ActiveSheet
    brr = .[a1].CurrentRegion
    ReDim Preserve arr(1 To 3, 1 To r)
    arr(1, r) = "地区"
    arr(2, r) = "水果"
    arr(3, r) = "销量"
    For i = 2 To UBound(brr)
        If brr(i, 1) = "湖南" And brr(i, 2) = "苹果" Then
            r = r + 1
            ReDim Preserve arr(1 To 3, 1 To r)
            arr(1, r) = brr(i, 1)
            arr(2, r) = brr(i, 2)
            arr(3, r) = brr(i, 3)
        End If
    Next
    '将筛选后的数组写入到单元格
    .Cells(1, "e").Resize(UBound(arr, 2), UBound(arr)) = Application.WorksheetFunction.Transpose(arr)
End With

'恢复屏幕更新，工作表自动重算
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

• 效果如图：
  

遍历目录下文件夹和文件区分存放

arr存放文件，brr存放文件夹

Sub find_dir()
Dim arr()
Dim brr()
Dim a, b As Byte

path1 = ThisWorkbook.Path & "\"
f = Dir(path1, vbDirectory)
Do While f <> ""
    If InStr(f, ".") > 0 Then
        a = a + 1
        ReDim Preserve arr(1 To a)
        arr(a) = f
    Else:
        b = b + 1
        ReDim Preserve brr(1 To b)
        brr(b) = f
    End If
    f = Dir
Loop

End Sub