使用VBA在Excel中搜索特定单词的数据，将该行以及上下两行复制到新工作表中

Question

我正在寻求有关我拥有的大量数据的帮助。我需要能够搜索特定单词的数据(使用输入框(，然后指定此行上方和下方显示的行数(再次使用输入框(以进行选择。这些行需要复制到一个新工作表中，我希望该工作表将以原始搜索值命名。

到目前为止，我有这个

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

到目前为止，我所拥有的是非常基本的，仅复制选择行并将该行输入到已经存在的工作表 -Sheet2 中。

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

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：添加新工作表，我认为您添加的代码还可以。但最好检查是否已经有一个名为'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

在艾哈迈德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