VBA數組用法-簡易實例

1、VBA數組的定義方法

下面是幾種數組常用的定義方法，一維數組的定義、二維數組的定義

直接賦值定義、調用Array函數定義、調用Excel工作表內存數組

''''''''''''直接定義給數組賦值 '一維常量數組的定義 Sub arrDemo1() Dim arr(2) As Variant '數組 arr(0) = "vba" arr(1) = 100 arr(2) = 3.14 MsgBox arr(0) End Sub '二維常量數組的定義 Sub arrDemo2() Dim arr(1, 1) As Variant 'Dim arr(0 To 1, 0 To 1) As Variant arr(0, 0) = "apple" arr(0, 1) = "banana" arr(1, 0) = "pear" arr(1, 1) = "grape" For i = 0 To 1 For j = 0 To 1 MsgBox arr(i, j) Next Next End Sub ''''''''''''用array函數創建常量數組 '一維數組 Sub arrayDemo3() Dim arr As Variant '數組 arr = Array("vba", 100, 3.14) MsgBox arr(0) End Sub '二維數組 Sub arrayDemo4() Dim arr As Variant '數組 arr = Array(Array("張三", 100), Array("李四", 76), Array("王五", 80)) MsgBox arr(1)(1) End Sub '調用Excel工作表內存數組 ' 一維數組[{"A",1,"C"}] '二維數組[{"a",10;"b",20;"c",30}] Sub mylook() Dim arr arr = [{"a",10;"b",20;"c",30}] Range("a1:b3") = arr MsgBox Application.WorksheetFunction.VLookup("b", arr, 2, 0) '調用vlookup時可以作為第二個參數 End Sub '動態數組的定義方法 Sub arrDemo5() Dim arr1() '聲明一個動態數組（動態指不固定大小） Dim arr2 '聲明一個Variant類型的變量  arr1 = Range("a1:b2") '把單元格區域A1：B2的值裝入數組arr1 arr2 = Range("a1:b2") '把單元格區域A1：B2的值裝入數組arr2  MsgBox arr1(1, 1) '讀取arr數組中第1行第1列的數值 MsgBox arr2(2, 2) '讀取arr1數組的第2行第2列的數值 End Sub

2、數組的賦值和計算

'讀取單元格數據到數組，進行計算，再賦值給單元格 Sub arr_calculate() Dim arr '聲明一個變量用來盛放單元格數據 Dim i% arr = Range("a2:d5") '把單元格數據搬入到arr里，它有4列4行 For i = 1 To 4 '通過循環在arr數組中循環  arr(i, 4) = arr(i, 3) * arr(i, 2) '數組的第4列(金額)=第3列*第2例 Next i Range("a2:d5") = arr '把數組放回到單元格中 End Sub

3、數組的合並（join）與拆分（split）

'數組合並(join)與拆分(Split) Sub join_demo() Dim a As Variant Dim b As Variant ' Join using spaces a = Array("Red", "Blue", "Yellow") b = Join(a, "") MsgBox ("The value of b is :" & b) 'Red Bule Yellow  ' Join using $ b = Join(a, "$") 'Red$Bule$Yellow MsgBox ("The Join result after using delimiter is : " & b) End Sub Sub split_demo() Dim a As Variant Dim b As Variant a = Split("Red$Blue$Yellow", "$") 'a = Array("red"，"blue"，"yellow")  b = UBound(a) For i = 0 To b MsgBox a(i) Next End Sub

4、數組的篩選（Filter）

'vba數組的篩選 Sub arr_filter() arr = Array("ABC", "F", "D", "CA", "ER") arr1 = VBA.Filter(arr, "A", True) '篩選所有含A的數值組成一個新數組 arr2 = VBA.Filter(arr, "A", False) '篩選所有不含A的數值組成一個新數組 MsgBox Join(arr1, ",") '查看篩選的結果 End Sub

5、數組維度的轉換（Transpose）

'數組維數的轉換  '一維轉二維 Sub arr_tranpose1() arr = Array(10, "vba", 2, "b", 3) arr1 = Application.Transpose(arr) MsgBox arr1(2, 1) '轉換后的數組是1列多行的二維數組 End Sub '二維數組轉一維 '注意:在轉置時只有1列N行的數組才能直接轉置成一維數組 Sub arr_tranpose2() arr2 = Range("A1:B5") arr3 = Application.Transpose(Application.Index(arr2, , 2)) '取得arr2第2列數據並轉置成1維數組 MsgBox arr3(4) End Sub '把單元格中的內容用“-”連接起來 Sub join_transpose_demo() arr = Range("A1:C1") arr1 = Range("A1:A5") MsgBox Join(Application.Transpose(Application.Transpose(arr)), "-") MsgBox Join(Application.Transpose(arr1), "-") End Sub

6、利用數組獲取所有工作表名稱的自定義函數

'利用數組獲取所有工作表名稱的自定義函數 Function getSheetsname(id) Dim i%, arr() k = Sheets.Count ReDim arr(1 To k) For i = 1 To k arr(i) = Sheets(i).Name Next getSheetsname = Application.Index(arr, id) End Function

7、數組賦值，提高計算效率

'數組賦值，提高計算效率 '2.03秒 Sub dataInput() Dim start As Double start = Timer Dim i& For i = 1 To 30000 Cells(i, 1) = i Next MsgBox "程序運行時間為" & Format(Timer - start, "0.00") & "秒" End Sub '0.12秒 Sub dataInputArr() Dim start As Double start = Timer Dim i&, arr(1 To 30000) As String For i = 1 To 30000 arr(i) = i Next Range("a1:a30000").Value = Application.Transpose(arr) MsgBox "程序運行時間為" & Format(Timer - start, "0.00") & "秒" End Sub '0.09秒 Sub dataInputArr2() Dim start As Double start = Timer Dim i&, arr(1 To 30000, 1 To 1) As String For i = 1 To 30000 arr(i, 1) = i Next Range("a1:a30000").Value = arr MsgBox "程序運行時間為" & Format(Timer - start, "0.00") & "秒" End Sub
摘自-VBA數組用法 - 天涯海角路 - 博客園 (cnblogs.com)