Question

我正在通过手动输入在列中运行搜索循环，并在找到的项目的右侧选择列的信息。

我不想立即显示结果，而是在搜索结束时将其显示为Messagebox中的表格。

因此我需要某种不断增长的内存堆栈或数组，但我不知道如何实现它。

我到目前为止编写下面的代码，搜索工作，信息收集没有。有人可以帮忙吗？

Sub Find_Tag()

Dim lr&, i&
Dim myTag As String
lr = Range("E" & Rows.Count).End(xlUp).Row

myTag = InputBox("Enter Tag. " & Chr(10) & "Use the syntax bellow:" & Chr(10) & "" & Chr(10) & "    J-XXXX")

For i = 1 To lr
    If Cells(i, "E").Value = myTag Then
        Cells(i, "E").Select
        Cells(i, "G").Select
        Cells(i, "P").Select

        MsgBox Cells(i, "E").Value & " " & Cells(i, "G").Value & "  " & Cells(i,"P").Value
    End If
Next i

End Sub

Answer 1

您可以增加邮件并在MessageBox中显示。像这样：

dim strMessage as string
dim strSpace   as string
strSpace = " "

For i = 1 To lr
    If Cells(i, "E").Value = myTag Then
        strMessage = strMessage & strSpace & Cells(i, "E").value
        strMessage = strMessage & strSpace & Cells(i, "G").value
        strMessage = strMessage & strSpace & Cells(i, "P").value

    End If
Next i

MsgBox strMessage

Answer 2

我的代码没有问题，除了你正在使用的无用的.Select。

Sub Find_Tag()
Dim lr&, i&
Dim myTag As String
Dim result As String
lr = Range("E" & Rows.Count).End(xlUp).Row

myTag = InputBox("Enter Tag. " & Chr(10) & "Use the syntax below:" & Chr(10) & "" & Chr(10) & "    J-XXXX")

For i = 1 To lr
If Cells(i, "E").Value = myTag Then
    result = Cells(i, "E").value & " " & Cells(i, "G").value & "  " & Cells(i, "P").value
    MsgBox result
End If
Next i

End Sub

这与您发布的内容相同，您确定要定位非空值吗？

Answer 3

以下代码将读取“E”，“G”和“P”列中的值，其中“E”列中的值为myTag，成为StringArr数组。

在循环结束时，将显示MsgBox中每个占用的数组元素。

Sub Find_Tag()

Dim lr&, i&, j&
Dim myTag As String
Dim StringArr() As Variant

lr = Range("E" & Rows.Count).End(xlUp).Row

myTag = InputBox("Enter Tag. " & Chr(10) & "Use the syntax bellow:" & Chr(10) & "" & Chr(10) & "    J-XXXX")

ReDim StringArr(1 To 1000) '<-- init to large size , optimize the size later
j = 1
For i = 1 To lr
    If range("E" & i).Value = myTag Then
        StringArr(j) = Range("E" & i).Value & " " & Range("G" & i).Value & " " & Range("P" & i).Value
        j = j + 1
    End If
Next i

ReDim Preserve StringArr(1 To j - 1) '<-- optimize array size

For i = 1 To UBound(StringArr) ' display all array elements in message box
    MsgBox StringArr(i)
Next i

End Sub

Answer 4

使用Find表示您还可以使用已找到地址的范围（rng2）
代码通过激活E,G and P的三列范围来完成，其中成功匹配在E（rng3）

代码

Sub PlanB()
    Dim rng1 As range
    Dim rng2 As range
    Dim rng3 As range
    Dim strMyTag As String
    Dim strAdd As String

    strMyTag = InputBox("Enter Tag. " & Chr(10) & "Use the syntax below:" & Chr(10) & "" & Chr(10) & "    J-XXXX")

    Set rng1 = Columns("E:E").Find(strMyTag, , xlFormulas, xlWhole)

    If Not rng1 Is Nothing Then
        strAdd = rng1.Address
        Set rng2 = rng1
        Do
            Set rng1 = Columns("E:E").FindNext(rng1)
              If Not rng1 Is Nothing Then
                If rng1.Address = strAdd Then Exit Do
                Set rng2 = Union(rng2, rng1)
            Else
                Exit Do
            End If
        Loop
    Else
        MsgBox strMyTag & " not Found"
        Exit Sub
    End If

    MsgBox strMyTag & " has been found these locations: " & rng2.Address

 Set rng3 = Union(rng2, rng2.Offset(0, 2), rng2.Offset(0, 11))
Application.Goto rng3

End Sub

保存搜索结果并返回地址列表

4 个答案: