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

这是一种在工作表中查找所有＆＃34; happiness＆＃34; 的方法，并将单元格地址保存在动态数组中。它使用查找（）和 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

Excel VBA添加发现到数组的单元格的地址

2 个答案: