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