[分享]VBA数组学习笔记

VBA数组学习笔记

常常在论坛看到很多VBA高手运用数组解决各种问题，速度快，代码简洁，很是羡慕，所以逐渐收集了一些资料，与大家分享，也请多多指教。在此，也向高手们致以谢意。

一、数组的分类

按元素数目分：元素数目大小固定的数组和元素数目大小不固定的动态数组。

按维数分：一维数组、多维数组。

Arr(1 to 12)、Arr1(0 to 24)----一维固定数组；

Arr2(1 to 5,1 to 8)---- 二维固定数组；

Arr3(5 to 10,6 to 12,1 to 100) ---- 三维固定数组。

动态数组

Dim Arr2(),r%

r=r+1

ReDim Preserve Arr2(1 To r) ―――动态数组；可以重新声明（只有最后一维的数目才能重新声明）；

用了关键字  Preserve  可确保原来包含数据的数组中的任何数据都不会丢失

二、数组的赋值

2.1，单元格区域保存到数组

arr = [e22:i24]

arr=Range(“e22:i24”)

2.2，Array函数

myArray = Array("AAA", "BBB", 200, 500, "2006-7-12")

如果代码头没有 Option Base 1 的语句，则数组myArray的上限为4，下限为0。

即下限LBound(myArr)=0 ，上限 UBound(myArr)=4

二维数组的第一维的上限：UBound(Arr,1)

二维数组的第二维的上限：UBound(Arr,2)

多维数组上限的求法一样。

2.3，把单元格区域公式赋给数组

如果a5=B4+1

arr = [a4:c8].Formula '将单元格绝对引用公式保存到数组

[e4:g8]=arr     此时e5中的公式也＝B4+1;

如果将单元格相对引用公式保存到数组

arr = [a4:c8].FormulaR1C1

如果a5=B4+1

[e4:g8]=arr     此时e5中的公式就＝E4+1;

三、数组的处理

3.1，数组里的最大值和最小值

最大值aa = Application.WorksheetFunction.Max(Arr)

aa= Application.WorksheetFunction.Large(Arr,1)

最小值aa = Application.WorksheetFunction.Min(Arr)

aa= Application.WorksheetFunction.Small(Arr,1)

3.2，数组里搜索

Temp = Filter(Arr, xm(i)) '搜索数组

Sub yy()
Dim Arr(), aa$, x%
aa = "asssfffssssaaasss": bb = "s"
For x = 1 To Len(aa)
    ReDim Preserve Arr(1 To x)
    Arr(x) = Mid(aa, x, 1)
Next x
temp = Filter(Arr, bb)
cc = UBound(temp) + 1    ‘cc=”s”的个数
End Sub

用于对字符串数组进行搜索，得到一个新的数组temp，

缺点：只告诉你某元素是否存在于数组中，而不知道其具体位置；

数组精确搜索：

Sub FilterExactMatch()

   ' 该函数在一个字符串数组中搜索那些

   ' 与搜索字符串完全匹配的元素。

   Dim astrFilter() As String

   Dim astrTemp() As String

   Dim lngUpper As Long

   Dim lngLower As Long

   Dim lngIndex As Long

   Dim lngCount As Long

   astrItems = Array("a", "sas", "s", "Sas", "s", "f", "f", "f", "f", "sas", "s", "sas", "a", "a", "Sas", "s", "s")

   strSearch = "Sas"

   ' 为搜索字符串而过滤数组。

   astrFilter = Filter(astrItems, strSearch)

   ' 存储结果数组的上限和下限。

   lngUpper = UBound(astrFilter)

   lngLower = LBound(astrFilter)

   ' 将临时数组调整到相同大小。

   ReDim astrTemp(lngLower To lngUpper)

   ' 在经过滤的数组的每个元素中循环。

   For lngIndex = lngLower To lngUpper

      ' 检查该元素是否与搜索字符串完全匹配。

      If astrFilter(lngIndex) = strSearch Then

         ' 在另一个数组中存储完全匹配的元素。

         astrTemp(lngCount) = strSearch

         lngCount = lngCount + 1

      End If

   Next lngIndex

   ' 重新调整包含完全匹配的元素的数组的大小。

   ReDim Preserve astrTemp(lngLower To lngCount - 1)

   ' 返回包含完全匹配的元素的数组。

   [a5].Resize(1, UBound(astrTemp) + 1) = Application.Transpose(astrTemp)

End Sub

3.3，转置

取工作表区域的转置到数组：arr=Application.Transpose([a1:c5])  ‘此时arr是转置成3行5列的数组，arr(1 to 3,1 to 5)

[e1:i3]=arr   ‘此时3行5列。

数组间也可以转置：arr1=Application.Transpose(arr)

取数组arr的第n列赋值到某列区域：[e1:e5]=Application.Index(arr, 0, n)

也可写成 [e1:e5]=Application.Index(arr, , n)

赋值产生一个新数组：arr1=Application.Index(arr,0 , n)

取数组arr的第n行赋值到某行区域：[a6:c6]=Application.Index(arr,n ,0 )

也可写成 [a6:c6]=Application.Index(arr,n ) 省略0，也省略了“，“

赋值产生一个新数组：arr1=Application.Index(arr, n )

3.4，数组的比较（字典法）

题目：将A列中的数据与C列相比较,输出C列中没有的数据到D列：

Sub cc()

‘by:ccwan

    Dim arr, brr, i&, x&, d As Object

    arr = Range("a1:a" & [a65536].End(xlUp).Row)

    brr = Range("c1:c" & [c65536].End(xlUp).Row)

    Set d = CreateObject("scripting.dictionary")

    For i = 1 To UBound(arr)

        d(arr(i, 1)) = ""

    Next

    For x = 1 To UBound(brr)

        If d.exists(brr(x, 1)) Then

            d.Remove brr(x, 1)

        End If

    Next

    [d1].Resize(d.Count, 1) = Application.Transpose(d.keys)

End Sub

3.5，数组的排序

字符串数组不能用Large(Arr,i) 或者 Small(Arr,i) 来排序；

但数值数组可以；

一个很好的字典+数组排序的实例：

Sub yy1()

‘by:oobird

 Dim i%, c As Range, x, d As Object

Set d = CreateObject("Scripting.Dictionary")

For Each c In Sheet2.UsedRange

    If c.Value <> "" Then

        If Not d.exists(c.Value) Then

            d.Add c.Value, 1

        Else

            d(c.Value) = d(c.Value) + 1

        End If

    End If

Next

    k = d.keys: t = d.items    'k是各个不重复值，t是各个不重复值的个数

    ReDim x(1 To 2, 1 To d.Count)

 For i = 1 To d.Count

    x(2, i) = Application.Large(k, i)   ‘从大到小排序

    x(1, i) = d(x(2, i))

 Next i

 With Sheet1

    .[b2].Resize(2, i - 1) = x

    ReDim x(1 To 2, 1 To d.Count)

    For i = 1 To d.Count

        x(1, i) = Application.Max(t)   ‘从大到小排序

        w = Application.Match(x(1, i), t, 0) – 1    ‘查找此值在不重复值系列中的排位，因为w是从0开始的，所以－1

        x(2, i) = k(w)    ‘求得对应的不重复值

        t(w) = ""     ‘使前面的最大值为空，继续循环

    Next i

    .[b5].Resize(2, i - 1) = x    ‘两行一起赋值给B5开始的单元格

End With

End Sub

字符串数组的排序，可以使用辅助列，把数组各元素依次赋给单元格，然后对这些单元格运用Excel自有的数据排序功能进行排序，再把单元格排过序的值重新赋给数组。

3.6，数组赋给单元格区域

r=Ubound(Arr)   r为一维数组的上限;

Range("a2").Resize(1, r) = Arr '填充到工作表的一行之中（Arr为一维数组）

或者写成 Range("a2").Resize(1, Ubound(Arr)) = Arr

二维数组Arr(100,5)

Range(“a1”).Resize(100,5)=Arr

[a1:e100]=Arr

或者写成 Range("a1").Resize(Ubound(Arr,1), Ubound(Arr,2)) = Arr

哈哈，现在才知道才知道这个是蓝桥！

感谢分享。

赋值方面的补充：

Sub y()
Dim arr
arr = [mmult(row(1:100),column(a:f))]
[a1].Resize(100, 6) = arr
End Sub

Sub yy()
Dim arr
arr = [column(a:z)^3]
MsgBox Join(arr, ",")
arr = [transpose(row(1:222))]
MsgBox Join(arr, ",")
End Sub

Sub yyy()
Dim arr
arr = Split("a b c d e f g")
MsgBox Join(arr, ",")
End Sub