保存搜索結果，並返回地址列表

我正在通過手動輸入在列中運行搜索循環，並在找到的項目的右側拾取列的信息。保存搜索結果，並返回地址列表

我不想立即顯示結果，但在搜索結束時顯示爲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

來源

2017-02-20 user36510

也許創建一個帶有列表框的用戶窗體並添加項目到它（避免@Viaata答案中提到的最大字符串長度）？我也會使用Find和FindNext，因爲它比遍歷所有行更快。 –

同意Darren。或者你可以使用AutoFilter並使用我設想的範圍 – brettdj

我對你的代碼沒有問題，除了你正在使用的無用.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

這與您發佈的內容相同，您確定要定位非空值嗎？

來源

2017-02-20 12:48:36 JiheL

下面的代碼將讀取列「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

來源

2017-02-20 12:55:06

您可以遞增郵件並在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

來源

2017-02-20 12:55:07 Vityata

，但是如果有超過100個匹配，你會怎麼做，導致String太大？ –

@Shai Rado - OP希望在一行中得到答案。超過30個，它已經是醜陋的。 – Vityata

嗨，大家好，感謝您的意見，它已經看起來不錯了。我在最後一個strMessage的末尾添加了一個「＆vbNewLine」，它工作得很好。我不算太多的結果，所以強度不應該成爲問題。 – user36510

使用Find意味着你也有一個範圍內找到的地址（rng2）的工作
代碼完成由activitating的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

來源

2017-02-20 13:38:38 brettdj

保存搜索結果，並返回地址列表

回答

相關問題