Question

我对VBA真的很陌生，我会尽力把问题弄清楚并且易于理解。

这是我在Excel中的示例，包含9行/行：

Hello_update1_ @ time10
1今天是晴天 2今天是美好的一天 Hello_update2_ @ time20
3今天是下雨天 4今天是糟糕的一天 Hello_update2_ @ time30
5今天是愉快的一天 6今天是美好的一天

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

Hello_update1_ @ time10
2今天是美好的一天 Hello_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

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

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

1 个答案: