网学网为需要Excel教程的朋友们搜集整理了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