Excel VBA將找到的單元格地址添加到數組

Question

我從cpearson.com上獲取了一些代碼，以查找所有頁面，讓我查找給定范圍內所有出現的搜索值。

我想要做的是將找到的單元格的.address傳遞給數組，以供稍后在我的代碼中使用。

Dim desk As String
Dim rng As Range
Dim itm() As Variant
Dim lastc As Range
Dim found As Variant
Dim firstaddr As String

Set rng = Sheets("Inventory").Range("A1:A200")

desk = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text

countd = Application.WorksheetFunction.CountIf(rng, desk)
'MsgBox desk
'MsgBox countd

With rng
    Set lastc = .Cells(.Cells.count)
End With

Set found = rng.find(desk, lastc, , xlWhole)

If Not found Is Nothing Then
    firstaddr = found.Address
End If

Do Until found Is Nothing
    ReDim Preserve itm(found.Address)  'get error 13 type mismatch here 
    itm(found.Address) = found.Address + 1
    'Debug.Print found.Address
    Set found = rng.FindNext(found)

    If found.Address = firstaddr Then
        Exit Do
    End If
Loop

End Sub

更新：

Dim desk As String
Dim countd As Long    
Dim rng As Range
Dim itm()
Dim lastc As Range
Dim found As Range
Dim firstaddr As String
Dim i As Integer

Set rng = Sheets("Inventory").Range("A1:A200")

desk = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text

countd = Application.WorksheetFunction.CountIf(rng, desk)
'MsgBox desk
'MsgBox countd
ReDim itm(countd)
With rng
    Set lastc = .Cells(.Cells.count)
End With

Set found = rng.find(desk, lastc, , xlWhole)

If Not found Is Nothing Then
    firstaddr = found.Address
End If
i = 0
Do Until found Is Nothing
    itm(i) = found.Address

    'Debug.Print found.Address
    Set found = rng.FindNext(found)

    If found.Address = firstaddr Then
        Exit Do
    End If
    i = i + 1
Loop

MsgBox "array is " & Join(itm, ", ")

End Sub

經過更多的谷歌搜索，並在下面的2個答案的幫助下，我能夠做到這一點而無需太多更改我的代碼。

現在，要使用該數組的每個元素在右側的單元格中搜索特定值，然后根據其響應獲取要搜索的單元格右側的單元格的值。 但這可能應該是另一個問題。

Answer 1

CPearson的FindAll函數返回一個Range對象。 要獲取包含地址的數組，請聲明該數組，並像TestFindAll一樣在數組的內容上循環：

Function GetAddresses(rng as Range) As String()

    Dim addresses() As String
    Redim addresses(rng.Count - 1)

    Dim i As Integer
    i = 0

    Dim cell As Range
    For Each cell In rng

        addresses(i) = cell.Address
        i = i + 1

    Next cell

    GetAddresses = addresses

End Function 

Answer 2

這是一種在工作表中查找所有“幸福”事件並將單元格地址保存在動態數組中的方法。 它使用Find（）和FindNext（）：

Sub dural()
    Dim s As String, r As Range, ary() As String
    ReDim ary(1)
    s = "happiness"
    Set r = Cells.Find(What:=s, After:=Range("A1"))
    ary(UBound(ary)) = r.Address(0, 0)

    Do
        Set r = Cells.FindNext(After:=r)
        If r Is Nothing Then Exit Do
        If ary(1) = r.Address(0, 0) Then Exit Do
        ReDim Preserve ary(UBound(ary) + 1)
        ary(UBound(ary)) = r.Address(0, 0)
    Loop

    MsgBox UBound(ary)
End Sub