VBA查找所有含有細胞及鄰近

我一直在試圖找到這裏一個線程，將覆蓋我的情況，但我一直不成功。我試圖搜索包含特定字符串的值的所有小區的給定範圍內（如果可能的多個例如

"*Text*Text*" that would find "123Text123Text123"串）

並返回來自該行的ID參考。到目前爲止，我已經成功地使用了「如果Cell.Value = xxx」的情景然而，這僅查找精確匹配，而不是含：

intMyVal = InputBox("Please enter Sales Order No.") 
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row 
    newrow = 1 
    For Each Cell In Range("D2:D" & lngLastRow) 'Data to search 
     If Cell.Value = intMyVal Then 
      Cells(Cell.Row, 1).Copy 'Copy ID1 value 
      Sheets("TempData").Cells(newrow, 1).PasteSpecial xlPasteValues 'Paste ID1 value in temp data 
      newrow = newrow + 1 
      End If 
    Next Cell

下面的圖像顯示了我這裏指的是數據的提取物。需要針對特定文本字符串（例如「Tesco」或「Ireland」）搜索列D，並且對於每個命中，列A中的對應值將需要被複制到臨時數據頁面。

如果任何人都可以建議這樣使用VBA找到正確的方法將是巨大的。

由於提前，丹

來源

2017-09-01 DannyBarnes01

而不是看每個單元使用FIND和FINDNEXT：

Public Sub FindSales() 

    Dim sValToFind As String 
    Dim rSearchRange As Range 
    Dim sFirstAdd As String 
    Dim rFoundCell As Range 
    Dim rAllFoundCells As Range 
    Dim sMessage As String 

    sValToFind = InputBox("Please enter Sales Order No.") 
    'Code to check a valid number entered 
    '. 
    '. 

    With ThisWorkbook.Worksheets("Sheet1") 
     Set rSearchRange = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) 
    End With 

    With rSearchRange 
     Set rFoundCell = .Find(sValToFind, LookIn:=xlValues, LookAt:=xlPart) 
     If Not rFoundCell Is Nothing Then 
      sFirstAdd = rFoundCell.Address 
      Do 

       sMessage = sMessage & rFoundCell.Row & ", " 

       'Create a range of found cells. 
       If Not rAllFoundCells Is Nothing Then 
        Set rAllFoundCells = Union(rAllFoundCells, rFoundCell) 
       Else 
        Set rAllFoundCells = rFoundCell 
       End If 
       Set rFoundCell = .FindNext(rFoundCell) 
      Loop While rFoundCell.Address <> sFirstAdd 
     End If 
    End With 

    rAllFoundCells.Copy Destination:=ThisWorkbook.Worksheets("Sheet2").Range("A1") 

    sMessage = sValToFind & " found on rows " & Mid(sMessage, 1, Len(sMessage) - 2) & "." 
    MsgBox sMessage, vbOKOnly + vbInformation 

End Sub

來源

2017-09-01 09:30:29

這是完美的感謝。由於我需要複製的值在不同列中進行查找，因此我稍作了修改。 '設置temp_dest = ThisWorkbook.Worksheets（「TempData的」） rAllFoundCells.Offset（，-3）.Copy temp_dest.Cells（1,1）.PasteSpecial粘貼：= xlPasteValues'' – DannyBarnes01

一個問題我現在具有這是當我擴大搜索到各個欄目。我上面使用的偏移方法只適用於當我知道數據將被發現的列時。您能否提出一個調整，允許我總是從列A中爲每一行數據複製返回肯定查找的數據？謝謝，丹 – DannyBarnes01

你可以添加新的'Range'變量，我稱之爲'rColA'。在'Create a range of found cells'註釋中添加以下代碼：設置'rColA = ThisWorkbook.Worksheets（「Sheet1」）。Cells（rFoundCell.Row，1）'。這將返回對找到的行的列A的引用。然後在兩個'Set rAllFoundCells ....'行中將'rFoundCell'改爲'rColA'。然後，您可以將'rSearchRange'更改爲任何列，並且它始終會返回列A中的值以查找所找到的行。 –

解決方法很簡單：使用Like操作：If someCell.Value Like "*Text*Text*" Then會做你想要什麼。

在你的情況，我想這將是：

If Cell.Value Like "*" & intMyVal & "*" Then

來源

2017-09-01 07:55:47

VBA查找所有含有細胞及鄰近

回答

相關問題