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

我希望我不会把你搞糊涂，但我想做的是

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

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

大概是这样的：

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

---

发布您迄今为止尝试过的VBA代码怎么样？我没有尝试过任何代码，因为我没有找到任何符合我要求的代码，因此我提出了这个问题。我将代码保存在某个地方，可以仅复制具有该值的行，当然。我可以告诉你，代码并不总是关于找到它，它更多的是关于编写它！我在编辑代码方面还不错，但绝对不足以从头开始编写这样的东西！因此我使用“发现”这个词。我可以编辑，有时也可以加入不同的代码，但任何比这更多的东西都是我目前无法胜任的。我还没来得及多练习，非常感谢！非常接近，我所需要做的就是添加一个偏移量。以前我自己尝试的代码使我的excel崩溃了，哈哈。非常感谢。对于那些将来可能会寻找这个的人来说，这个偏移量看起来是这样的：c.EntireRow.offset-1.Resize2.Copy shtDest.CellsdestRow，1 destRow=destRow+2是的，我忘了上面的那一行也是你想要的，而不是下面的那一行…@Tim Williams:Wow！我喜欢那部分！节省了我很多工作，而且更容易阅读和维护！比我平时做的要多。