使用 VBA 在 Excel 中搜索特定单词的数据，将该行和上下两行复制到新的 sheet

Question

我正在寻求有关我拥有的大量数据的帮助。我需要能够搜索特定单词的数据（使用输入框），然后指定该行上方和下方出现的行数（再次使用输入框）也 select。这些行需要复制到一个新的 sheet，我希望它能以原始搜索值命名。

到目前为止我有这个

Private Sub CommandButton1_Click()
a = Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
nr = Application.InputBox("Enter customer name to find", "SEARCH VALUE")
        If nr = False Then Exit Sub

For i = 2 To a

If Worksheets("Database").Cells(i, 4).Value = nr Then

    Worksheets("Database").Rows(i).Copy
    Worksheets("Sheet2").Activate
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet2").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("Database").Activate

End If

Next

End Sub

到目前为止我所拥有的是非常基本的，只复制 select 行并将该行输入到已经存在的 sheet -Sheet2.

我知道这里还有其他关于将行复制到新 sheet 的帖子，但我还没有找到有两组标准的帖子（一组用于文本，第二组用于上面的行数及以下）并在第一个搜索变量之后命名新的 sheet。

Answer 1

尝试，在第一个输入框之后

N = InputBox("Enter Number of Rows Above or below", "Offset")
        If N = "" Then Exit Sub
N = Val(N)

然后如果...然后

Srow = IIf(i - N <= 0, i, i - N)
Erow = i + N
Worksheets("Database").Rows(Srow & ":" & Erow).Copy

编辑2：添加新作品sheet，我觉得你添加的代码没问题。但最好检查是否已经有任何 sheet 命名为 'nr'
可以根据您的要求尝试以下任何一项

have = False
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = nr Then have = True
    Next

    If have = False Then
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = nr
    End If

或

For Each ws In ActiveWorkbook.Worksheets
If ws.Name = nr Then ws.Delete
Next
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = nr

Answer 2

在 Ahmed AU 的额外帮助下，我设法解决了这个问题。

Private Sub CommandButton1_Click()
a = Worksheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
nr = Application.InputBox("Enter customer code", "SEARCH VALUE")
    If nr = False Then Exit Sub

N = InputBox("Enter additional number of rows", "Offset")
    If N = "" Then Exit Sub
    N = Val(N)

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = nr
Worksheets("Database").Activate

For i = 2 To a

If Worksheets("Database").Cells(i, 4).Value = nr Then


Srow = IIf(i - N <= 0, i, i - N)
Erow = i + N
Worksheets("Database").Rows(Srow & ":" & Erow).Copy
Worksheets(nr).Activate
b = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Database").Activate


End If

Next

End Sub

使用 VBA 在 Excel 中搜索特定单词的数据，将该行和上下两行复制到新的 sheet

Using VBA to search data in Excel for a specific word, copy that row and 2 rows above and below into a new sheet

excel

vba

row

spreadsheet

copying