VBA查找包含和复制相邻的所有单元格

Question

大家早上好，

我一直试图在这里找到一个可以涵盖我的情况的线程，但我没有成功。我正在尝试搜索包含特定字符串值的所有单元格（如果可能的话，多个字符串，例如

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

在给定范围内并从该行返回ID引用。到目前为止，我已设法使用“If 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

下图显示了我所指的数据的摘录。需要在列D中搜索特定的文本字符串（例如“Tesco”或“Ireland”），并且对于每个命中，需要将A列中的对应值复制到临时数据页面。

如果有人可以建议使用VBA查找的正确方法，那将是很好的。

提前谢谢，丹

Answer 1

而不是看每个单元格使用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

Answer 2

解决方案很简单：使用Like操作符：If someCell.Value Like "*Text*Text*" Then将完全按照您的意愿执行操作。

在你的情况下，我认为它将是：

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