Excel VBA数组基础

Excel VBA数组基础

数组为可以存储多个数据的变量。

声明数组

Dim myArray(2)

声明一个含有3个元素的数组，即myArray(0)、myArray(1)、myArray(2)

Option Base 1

Dim myArray(2) As Integer

声明一个含有2个元素的数组，即myArray(1)、myArray(2)，数据类型为Integer型。Option Base语句用来改变数组的下界，指定数组基数从1开始。

Dim myArray(1 To 10)

声明一个含有10个元素的数组，数组基数从1开始。这是另一种改变数组下界的方法，即在定义数组的同时，指定数组的上界和下界。

Dim myArray(1 To 10, 1 To 20)

声明一个10行20列的数组。

获取数组的下界和上界

LBound函数：获取数组的下界

UBound函数：获取数组的上界

说明：

●UBound函数返回数组的上界，数组中实际的元素个数取决于其下界。如果使用缺

省下界值0，UBound函数返回的值比数组实际元素个数小1。例如，如果数组变量

myArray有10个元素且下界为0，那么UBound(myArray)返回值为9，因此数组中

元素的总数应为：UBound(myArray)+1

如果下界设置为1，那么UBound函数的返回值就等于数组的实际元素数。

因此，在确定数组元素个数时，要同时使用UBound函数和LBound函数才能确保

结果正确：

UBound(myArray)-LBound(myArray)+1

●在使用UBound函数之前，数组应该初始化，否则会导致“下标越界”错误。

●可以对多维数组使用UBound函数，但需要指定数组中的一个维数。若不指定维数，

默认为第1维。

上界：UBound(myArray,dimensionNo)

下界：LBound(myArray,dimensionNo)

给数组赋值

Option Base 1

Sub FillArray1()

Dim i As Long

Dim myArray(10) As Long

For i = 1 To 10

myArray(i) = i

Next i

End Sub

示例2：

Option Base 1

Sub FillArray2()

Dim i As Long

Dim myArray As Variant

'使用Array函数填充数组

myArray = Array("姓名", "性别", "住址", "电话")

'将数组值写入工作表

With Worksheets("Sheet1")

For i = 1 To UBound(myArray)

.Cells(1, i).Value = myArray(i)

Next i

End With

End Sub

在本示例中，先创建Variant型的变量myArray，然后输入数组值使其成为数组。运行后，结果如下图1所示。

图1：使用数组填充工作表示例3：

Option Base 1

Sub FillArray3()

Dim myArray As Variant

Dim i As Long

'创建一个5行2列的数组并赋值

myArray = Worksheets("Sheet2").Range("A1:B5")

'遍历数组并输出值

For i = LBound(myArray) To UBound(myArray)

Debug.Print myArray(i, 1), myArray(i, 2)

Next i

运行后，结果如下图2所示。

图2：使用数组填充工作表

说明：

?遍历数组中所有元素使用代码：

For Each myElement In MyArray

mySum = mySum + myElement

Next

比下面的代码更快：

For i = LBound(MyArray) To UBound(MyArray)

mySum = mySum + MyArray(i)

Next

并且，不用担心数组的下界和上界。但是For Each仅仅读取数组元素，如果要修改myElement，数组中的相应元素保持不变。无论数组元素是什么数据类型，myElement 必须是变体数据类型。

?可以使用下面的代码检查数据类型变量是否包含数组：

IsArray (myVariant)

处理数组中的数据

示例4：返回数组中的最大数

Sub MaxNumInArray()

Dim myArray As Variant

myArray = Worksheets("Sheet2").Range("A1:B5")

MsgBox "最大数是：" & WorksheetFunction.Max(myArray)

示例5：求每一行的平均数

Sub AverageNum()

Dim myArray As Variant

Dim i As Long

myArray = Worksheets("Sheet2").Range("A1:B5")

For i = LBound(myArray) To UBound(myArray)

Worksheets("Sheet2").Cells(i, 3).Value = _

WorksheetFunction.Average(myArray(i, 1), myArray(i, 2))

Next i

End Sub

示例6：结合使用命名区域来处理数组

将A1:A10命名为myData，程序代码如下：

Sub TransposeArray()

Dim myArray As Variant

myArray = WorksheetFunction.Transpose(Range("myData"))

'返回数组中的第6个元素

MsgBox "数组中的第6个元素是：" & myArray(6)

End Sub

如果列元素不转置的话，会出现“下标越界”错误。

动态数组

动态数组事先没有设置数组的大小，例如，声明

Dim myArray()

然后，使用ReDim命令来设置数组的大小，从而扩展数组元素的数目。也可以用ReDim声明一个动态数组的同时，指定该数组的元素个数。

示例7：

Sub SheetsName()

Dim myArray() As String

Dim i As Long, lShtNum As Long

'当前工作簿中的工作表数

lShtNum = ActiveWorkbook.Worksheets.Count

'设置数组大小

ReDim myArray(1 To lShtNum)

'将工作表名赋给数组

For i = 1 To lShtNum

myArray(i) = ActiveWorkbook.Sheets(i).Name

Next i

End Sub

在重新设置数组大小时，可以使用Preserve命令保留数组中原来已存在的数据，例如：

说明：

●如果重新定义数组时，数组的大小比原数组小，则会丢失部分数据元素。

●可以使用ReDim命令重新定义多维数组的大小，即改变数组的维数或每一维的大

小。

●对于多维数组，使用Preserve 命令只能改变数组最后一维的大小，但不能改变数组

的维数。

示例8：搜索某文件夹中所有的Excel文件，并在数组中存放结果。

Sub ExcelFiles()

Dim strFileName As String

Dim strNames() As String

Dim i As Long, j As Long

strFileName = Dir("C:\Users\Administrator\Documents\*.xls*")

Do Until strFileName = ""

i = i + 1

ReDim Preserve strNames(1 To i)

strNames(i) = strFileName

strFileName = Dir

Loop

For j = 1 To i

Debug.Print strNames(j)

Next j

End Sub

将数组作为参数传递

示例9：

如下图3所示的工作表，根据不同的产品求和，并将结果返回。

图3：示例工作表Sub PassDatawithArray()

Dim myArray() As Variant

Dim strProduct As String

'ProductData为包含所有数据的区域名称

myArray = Range("ProductData")

strProduct = InputBox("输入产品名－食品、服装、电器")

MsgBox strProduct & "销售量是:" & _

Format(ProductSales(myArray, strProduct), "$#,#00.00")

End Sub

Function ProductSales(ByRef passedArray As Variant, _

strPassedProduct As String) As Long

Dim i As Long

ProductSales = 0

For i = LBound(passedArray) To UBound(passedArray)

'产品名在数据区域的第1列，因此也是数组的第1列

If passedArray(i, 1) = strPassedProduct Then

'要汇总的数据在第6列

ProductSales = passedArray(i, 5) + ProductSales

End If

Next i

End Function

运行结果如下图4所示：

图4：求和结果

说明：

数组作为参数传递时总是使用ByRef，意味着仅仅指向数组的指针被传递给函数或过程，而不是数组本身。如果在过程中改变数组，那么在调用程序中也相应改变。

如果要按值传递数组，使用：

Run "Procedurename", Parameter1, Parameter2, ...

由于Run自动将所有参数转换为值，在被调过程中改变数组不会影响原来的数组。多维数组与数组的数组

如果一个数组超过一维，那么称之为多维数组。维数是需要识别单个元素的索引的数量。列表通常是一维数组，表是二维数组，可以通过提供行和列索引识别每个元素。也有三维以上的数组，但很少使用。

有时，应用程序中的数据结构是二维的但是不规则。例如，能够以月数组来创建日历，而每月包含天数数组。由于不同的月有不同的天数，因此元素不会形成规则的二维数组。

当然，仍然使用二维数组，只是忽略代表无效日期的元素（例如2月的第31天）。但是，可以使用所谓的交错数组（jagged array），或者数组的数组（an array of arrays）。这是一个一维数组，其中的每个元素又包含着一个数组。这些数组的大小无须相同，因此非常适合不规则的数据结构。

在VBA中，不能够使用Dim语句声明交错数组。相反，声明一个一维主数组类型变体（可以是静态的或动态的）。由于变体数据类型变量能够包含数组，因此可以在运行时赋子数组

给主数组的每个元素。这些子数组不需要是变体类型，其数据类型应该与想要在其中存储的数据的类型一致，但也可以使它们也是变体类型并在其中放置（子）子数组。

使用下面的方式访问二维数组的单个元素：

myArray(Index1, Index2)

像下面这样提取交错数组中的单个元素：

myArray(Index1)(Index2)

示例10：下面使用日历示例展示如何创建和处理上面讲的两种类型的数组：

'处理二维数组

Sub TestMulti()

Dim i As Integer

Dim myDays As Integer

Dim myYear(1 To 12, 1 To 31) As String

'输入假期天数

myYear(3, 15) = "假期"

myYear(3, 16) = "假期"

'统计假期天数

For i = 1 To 31

If myYear(3, i) = "假期" Then

myDays = myDays + 1

End If

Next

'显示结果

MsgBox "在三月有" & myDays & " 天假期."

End Sub

'处理数组的数组

Sub TestJagged()

Dim i As Integer

Dim myDays As Integer

Dim myYear(1 To 12) As Variant

Dim myMonth() As Variant

'创建数组的数组

For i = 1 To 12

'获取每月正确的天数

myDays = Day(DateSerial(Year(Date), i + 1, 1) - 1)

'创建月数组

ReDim myMonth(1 To myDays)

'将数组赋值给年

myYear(i) = myMonth

Next

'输入假期天数

myYear(3)(15) = "假期"

myYear(3)(16) = "假期"

'统计假期天数

myDays = UBound(Filter(myYear(3), "假期")) + 1

'显示结果

MsgBox "在三月有" & myDays & " 天假期."

End Sub

补充示例

示例11：数组元素排序

下面的程序对数组MyArray中的字符串排序。在A1:A10中输出未经排序的数组值，然后排序数组后，在B1:B10中输出新的排好序的数组值。也可以将数组值输出到Excel工作表，使用Excel内置的排序功能排序，然后再使用已排序的值填充数组。

程序代码中，使用了工作表函数Transpose，将数据输出到列中，也可以不使用这个函数，直接将数据输出到行：

Range(Cells(1, 1), Cells(1, UBound(MyArray))) = MyArray

程序代码如下：

Sub SortArray()

Dim MyArray(10) As String

Dim lLoop As Long, lLoop2 As Long

Dim str1 As String

Dim str2 As String

'填充数组

For lLoop = 0 To 10

If lLoop = 0 Then

MyArray(lLoop) = "Zoo"

Else

MyArray(lLoop) = Choose(lLoop, "Farm", "Paddock", "Sheep", _

"Cow", "Bird", "Mice", "Chicken", "Fence", "Post", "Lamb") End If

Next lLoop

'输出未排序的数组

Range("A1:A" & UBound(MyArray) + 1) = _

WorksheetFunction.Transpose(MyArray)

'排序数组

For lLoop = 0 To UBound(MyArray)

For lLoop2 = lLoop To UBound(MyArray)

If UCase(MyArray(lLoop2)) < UCase(MyArray(lLoop)) Then

str1 = MyArray(lLoop)

str2 = MyArray(lLoop2)

MyArray(lLoop) = str2

MyArray(lLoop2) = str1

End If

Next lLoop2

Next lLoop

'输出排序的数组

Range("B1:B" & UBound(MyArray) + 1) _

= WorksheetFunction.Transpose(MyArray) End Sub