Excel 如何将单元格或量程传递到InStr？

我试图根据每行的特定单元格中是否存在字符串，将一行从一个工作表复制到另一个工作表。在下面的示例中，我在第J列中搜索Jordan。如果该名称在第J列的这一特定行中，它将移动到另一张图纸（最终图纸）

我要做的是查找多个字符串。我可以通过添加如下所需的任意多个“或”来实现这一点

If InStr(1, Cells(i, "J"), "Jordan") > 0 Or InStr(1, Cells(i, "J"), "Barkley") > 0 Then

我通常会搜索5+个字符串，每次都很难更新代码。我希望我查找的字符串位于某个隐藏表上的一系列单元格中，我或其他人可以轻松更新这些单元格。我一直在修补下面的东西。如果是单个单元格，则范围不起作用。如果它更像A1:A5，那么它会断裂。有没有想过我该如何做到这一点？我是否完全错过了一个优雅的解决方案

Sub Test()
Worksheets("All Data").Activate

Dim N As Long, i As Long
    N = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To N
        If InStr(1, Cells(i, "J"), Worksheets("List").Range("A1:A5")) > 0 Then
            Worksheets("All Data").Rows(i).Copy
            Worksheets("Final Sheet").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next i
End Sub

List Sheet
- |    A    |
1 | Jordan  |
2 | Barkley |
3 | Batman  |
4 | Robin   |
5 | Ozzy    |

基于，我根据您的场景对其进行了自定义

请记住在运行数据之前备份数据

阅读代码注释并调整变量值以满足您的需要

Public Sub CopyData()

    ' Define the object variables
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet

    Dim listRange As Range
    Dim evalCell As Range

    ' Define other variables
    Dim listRangeAddress As String

    Dim startSourceRow As Long
    Dim lastSourceRow As Long
    Dim columnForLastRowSource As Long

    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnForLastRowTarget As Long

    Dim columnToEval As Long


    ''''' Adjust the folloing values ''''

    ' Set the lookup list range address
    listRangeAddress = "B1:B5"

    ' Adjust the worksheets names
    Set sourceWorksheet = ThisWorkbook.Worksheets("All Data")
    Set targetWorksheet = ThisWorkbook.Worksheets("Final Sheet")
    Set listRange = ThisWorkbook.Worksheets("List").Range(listRangeAddress)

    ' Set the initial row where data is going to be evaluated
    startSourceRow = 1

    ' Set the column from which you're going to get the last row in sourceSheet
    columnForLastRowSource = 1

    ' Set the column from which you're going to get the last row in targetSheet
    columnForLastRowTarget = 1

    ' Set the column where you evaluate if condition is met
    columnToEval = 10



    '''''''Loop to copy rows that match'''''''

    ' Find the number of the last row in source sheet
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, columnForLastRowSource).End(xlUp).Row

    For sourceRowCounter = startSourceRow To lastSourceRow

        For Each evalCell In listRange.Cells

            ' Evaluate if criteria is met in column
            If InStr(sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value, evalCell.Value) > 0 Then

                ' Get last row on target sheet (notice that this search in column A = 1)
                lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, columnForLastRowTarget).End(xlUp).Row

                ' Copy row to target
                sourceWorksheet.Rows(sourceRowCounter).Copy targetWorksheet.Rows(lastTargetRow + 1)

                ' If found, don't keep looking
                Exit For

            End If

        Next evalCell

    Next sourceRowCounter

End Sub

---

让我知道它是否有效，如果有效，记得标记答案。

这些单元格是否也包含其他文本，例如“foo Jordan bar”或仅“Jordan”？如果是前者，可能会有所帮助。快速的第一句话：

单元格（Rows.Count，1）。End（xlUp）。Row

将在当前的

活动表上工作。由于您处理
工作表中的行（“所有数据”）
，因此我认为可能的最后一行并不一定是您所追求的。即使如此@BigBen，您也被允许使用
*
通配符=）
AutoFilter
确实是一个很好的建议。当你传递一个要搜索的值数组时（这将不允许使用通配符）@JvdV-我知道通配符是允许的，只是不确定你是否可以将它们合并到这个例子中，但是是的，我会这样做。@BigBen这些单元格确实包含其他文本！有时是一整段。我试着用上面的名字来保持这个例子的简单：）哇，这很有魅力。老实说，我整个上午都在反复阅读这段代码，以便更好地理解它是如何工作的（它确实如此）。它的运行速度也比我加起来的要快得多。我在大约5000多行的数据集上运行这个。用我的代码，它将使excel翻转大约2分钟，但你的只是有一个鼠标加载符号，并完成得更快，我想。它也没有像我通常会错过的那样，在第一次通过时丢失任何数据。我一定会继续研究这个问题，并把它作为基准，让我的工作更轻松。！
Public Sub CopyData()

    ' Define the object variables
    Dim sourceWorksheet As Worksheet
    Dim targetWorksheet As Worksheet

    Dim listRange As Range
    Dim evalCell As Range

    ' Define other variables
    Dim listRangeAddress As String

    Dim startSourceRow As Long
    Dim lastSourceRow As Long
    Dim columnForLastRowSource As Long

    Dim lastTargetRow As Long
    Dim sourceRowCounter As Long
    Dim columnForLastRowTarget As Long

    Dim columnToEval As Long


    ''''' Adjust the folloing values ''''

    ' Set the lookup list range address
    listRangeAddress = "B1:B5"

    ' Adjust the worksheets names
    Set sourceWorksheet = ThisWorkbook.Worksheets("All Data")
    Set targetWorksheet = ThisWorkbook.Worksheets("Final Sheet")
    Set listRange = ThisWorkbook.Worksheets("List").Range(listRangeAddress)

    ' Set the initial row where data is going to be evaluated
    startSourceRow = 1

    ' Set the column from which you're going to get the last row in sourceSheet
    columnForLastRowSource = 1

    ' Set the column from which you're going to get the last row in targetSheet
    columnForLastRowTarget = 1

    ' Set the column where you evaluate if condition is met
    columnToEval = 10



    '''''''Loop to copy rows that match'''''''

    ' Find the number of the last row in source sheet
    lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, columnForLastRowSource).End(xlUp).Row

    For sourceRowCounter = startSourceRow To lastSourceRow

        For Each evalCell In listRange.Cells

            ' Evaluate if criteria is met in column
            If InStr(sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value, evalCell.Value) > 0 Then

                ' Get last row on target sheet (notice that this search in column A = 1)
                lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, columnForLastRowTarget).End(xlUp).Row

                ' Copy row to target
                sourceWorksheet.Rows(sourceRowCounter).Copy targetWorksheet.Rows(lastTargetRow + 1)

                ' If found, don't keep looking
                Exit For

            End If

        Next evalCell

    Next sourceRowCounter

End Sub