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