需要一个搜索值的宏，如果为true，则选择具有值和上面一行的行

Question

我希望我不要迷惑你，但这就是我想要做的事情。

以下是工作表中某些数据的示例：

Excel屏幕截图

基本上我有6个四位数字的标准，例如（3413,3414,3417等）我需要宏来搜索任何具有以这些数字开头的数字的行，并将值所在的行和上面的行复制到新工作表中。我需要上面的行，因为它中有客户的名字。

在这种情况下，宏将在第2行中找到值并复制第2行和第1行。

我似乎无法找到与我有同样问题的人，有人可以帮忙吗？谢谢！

编辑 - 这可能是我的开始代码：

Sub Test()
For Each Cell In Sheets(1).Range("J:J")
    If Cell.Value = "131125" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select
    End If
Next
End Sub

Answer 1

这样的事情：

Sub Test()
    Dim c As Range, shtSrc As Worksheet, shtDest As Worksheet
    Dim arr, v, txt, destRow As Long

    arr = Array(3413, 3414, 3417) '<< array of values to look for

    Set shtSrc = Sheets("Sheet1")
    Set shtDest = Sheets("Sheet2")
    destRow = 2 'start copying to here

    'ignore empty ranges
    For Each c In Application.Intersect(shtSrc.Range("J:J"), _
                                        shtSrc.UsedRange).Cells
        txt = c.Value
        For Each v In arr
            'does the cell contain the search number ?
            If txt Like "*" & v & "*" Then
                'copy to same row on sheet2
                c.EntireRow.Resize(2).Copy shtDest.Cells(c.Row, 1)

                '...or copy below previous hit
                'c.EntireRow.Resize(2).Copy shtDest.Cells(destRow, 1)
                'destRow = destRow + 2

                Exit For '<< stop checking this row
            End If
        Next v
    Next

End Sub