首页 文章

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

提问于
浏览 次
2

我对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今天是美好的一天

谢谢 .

excel-vba vba excel

1 回答

  • 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

    这是 untested 所以可能需要一些调试 .

    回复于

相关问题