Excel VBA可基于文本将整行从一个工作表复制并粘贴到同一工作簿中的另一个工作表

我对VBA真的很陌生，我会尽我最大的努力把这个问题安排得很好，很容易理解

以下是我在Excel中的9行示例：

你好u update1_u@time10
1今天是个阳光明媚的日子
2今天是个好日子
您好，更新2@time20
3今天是雨天
4今天天气不好
您好，更新2@time30
5今天是愉快的一天
今天是个好日子

我已经使用了一个代码来查找具有特定文本的行（例如：“good”），并将其复制到一个新的工作表中，如下所示。但是我需要添加一个代码，在我找到文本为“good”的行之后，在文本为“good”的行的正上方的第一行也将被复制并粘贴到新的工作表中。像这里一样，必须首先复制并粘贴行“Hello_update1_@time10”，然后应出现“2 Today is good day”，以此类推，即最终结果应为：

你好u update1_u@time10
2今天是个好日子
您好，更新2@time30
今天是个好日子

Sub find_good_copy()
    Dim K As Long, r As Range, v As Variant
    K = 2

    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Tabelle1
    Set w2 = Tabelle3

    w1.Activate

    For Each r In Intersect(Range("B:B"), ActiveSheet.UsedRange)
        v = r.Value
        If InStr(v, "good") > 0 Then
            w2.Cells(1, 1) = "good"
            r.EntireRow.Copy w2.Cells(K, 1)
            K = K + 1
        End If
    Next r
End Sub

表1和表3是所用工作表的名称。 目前，我使用上述代码的输出是：
2今天是个好日子
今天是个好日子

Sub find_good_copy()
    Dim K As Long, r As Range, v As Variant
    K = 2

    Dim w1 As Worksheet
    Dim w2 As Worksheet
    Set w1 = Tabelle1
    Set w2 = Tabelle3

    w1.Activate

    For Each r In Intersect(Range("B:B"), ActiveSheet.UsedRange)
        v = r.Value
        If InStr(v, "good") > 0 Then
            w2.Cells(1, 1) = "good"
            r.EntireRow.Copy w2.Cells(K, 1)
            K = K + 1
        End If
    Next r
End Sub

---

谢谢。

请参见下面代码的更改。评论解释了我改变了什么以及为什么

Sub find_good_copy()
    Dim K As Long, r As Range, v As Variant
    K = 2

    Dim w1 As Worksheet, w2 As Worksheet
    Set w1 = Tabelle1
    Set w2 = Tabelle3

    Dim hRow As Integer                     'Declare new variable to keep track of rows
    Dim lRow As Integer        
    h = 2                                   'Set it equal to the first row of your search range

    'Find the last row in a dataset
    lRow = w1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row                

    w1.Activate

    For r = 1 to lRow
        v = w1.Range("A" & r).Value
        If InStr(v, "Hello") > 0 Then       'Check for "Hello"
            hRow = r                        'Found it, save row number
                                            'When it finds the next one, it will save that row number instead
        ElseIf InStr(w1.Range("B" & r).value, "good") > 0 Then
            w2.Cells(1, 1) = "good"
            ws1.Rows(hRow).EntireRow.Copy w2.Cells(K, 1)  'Copy the "Hello" row first
            ws1.Rows(r).EntireRow.Copy w2.Cells(K + 1, 1) 'Copy the row second (need to increase K to copy to next row)
            K = K + 2                       'Need to increase K by 2 instead to account for 2 rows added, not 1
        End If
    Next r
End Sub

---

这是未经测试的，因此可能需要一些调试

我尝试了同样的方法，结果在第“hRow.Copy w2.Cells（K，1）”行显示了一个错误。当我将光标移到这条线正上方的hRow时，它显示“hRow=Nothing”。是因为找不到包含Hello的行吗？错误消息显示“object variable not fixed”。在我的Excel中，Hello总是出现在A列中，而good一词出现在B列中。那么使用“对于Intersect（范围（“B:B”）、ActiveSheet.UsedRange中的每个r”是否正确呢？此外，由于每个单词之间都有“Hello”，那么在检测Hello一词时会出现问题吗？1）问题是它在B列中搜索“Hello”“正如您所述，它位于A列中，因此它从未找到搜索字符串。2） 请参见编辑：添加

lRow

变量并将循环更改为For循环。如果要搜索的行数较少，这不会有什么区别（因为每个循环都有大量数据）。3） 下划线不影响字符串中的搜索。它仍然会发现“你好”很棒，现在它工作得很好。逻辑清晰易懂。我只是有一个小错误，必须将“r”作为Range做一个小更改，将“r”作为Integer，因为传递的值是整数。非常感谢你的帮助。