VBA数组学习笔记(二)

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