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

Question

我对 VBA 真的很陌生，我会尽我所能很好地构建问题并且易于理解。

这是我在 Excel 中的示例，有 9 行/行:

你好_update1_@time10
1 今天是个晴天
2 今天是个好日子
你好_update2_@time20
3 今天是个阴雨天
4 今天天气不好
你好_update2_@time30
5 今天是愉快的一天
6今天是个好日子

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

你好_update1_@time10
2 今天是个好日子
你好_update2_@time30
6今天是个好日子

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

Tabelle1 和 Tabelle3 是使用的工作表的名称。
目前，我使用上述代码的输出是:
2 今天是个好日子
6今天是个好日子

谢谢。

Answer 1

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

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

这是 未经测试所以可能需要一些调试。