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

【问题标题】：Using VBA to search data in Excel for a specific word, copy that row and 2 rows above and below into a new sheet使用 VBA 在 Excel 中搜索特定单词的数据，将该行和上下 2 行复制到新工作表中
【发布时间】：2018-10-23 09:31:00
【问题描述】：

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

到目前为止我有这个

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 中。

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

【问题讨论】：

我编辑了我的答案。请看一下。另外，对于您的原始问题的进一步查询，我认为最好编辑您的原始问题和/或评论，而不是发布另一个答案。

标签： excel vba row spreadsheet copying

【解决方案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

【讨论】：

感谢您帮助我输入行数。我仍在努力创建新工作表。我以为我有它，但我最终为找到的每个条目创建了一个新工作表。对此的任何建议将不胜感激。谢谢。
我正要检查确保没有其他工作表具有相同的名称。感谢您添加此内容。非常感谢。

【解决方案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

【讨论】：