使用 VBA 在包含特定关键字的任何行之后添加一行并用数据填充列

Using VBA to add a row after any row that contain a certain keyword and fill columns with data

我需要在包含关键字“skimmer”的任何行之后添加一行,然后用以下数据填充列:

A​​ 列和 B 列:匹配上一行中此列中的数据。

带有文本的 D、F、H、I、J、K 列(这些将始终相同)

这是我目前所拥有的,这不是添加行,似乎代码无法识别 excel 中的关键字,即使知道文本在那里..

Sub Skimmer()
Set rng2 = Range("A1").CurrentRegion
lr4 = rng2.Cells(Rows.Count, "K").End(3).Row

For i = lr4 To 2 Step -1
    If rng2.Cells(i, 11) Like "*Skimmer*" Then
        rng2.Cells(i, 11).Offset(1).EntireRow.Insert
        rng2.Cells(i, 3).Offset(1).Resize(1, 9).Value = _
        Array("", "ColD", "", "ColF", "", "ColH", "ColI", "ColJ", "ColK")
        rng2.Cells(i, 1).Offset(1).Resize(1, 2).Value = rng2.Cells(i, 1).Resize(1, 2).Value
    End If
Next i

End Sub

插入范围行并填充数据

  • 这会在范围内插入行,而不是整行,即范围右侧的任何数据都保持不变。

紧凑

Sub InsertSkimmersCompact()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rng2 As Range: Set rng2 = ws.Range("A1").CurrentRegion
    Dim r As Long
    For r = rng2.Rows.Count To 2 Step -1
        If LCase(rng2.Cells(r, "K").Value) Like "*skimmer*" Then
            With rng2.Rows(r).Offset(1)
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
                With .Offset(-1)
                    .Columns("A:B").Value = .Offset(-1).Columns("A:B").Value
                    .Columns("C:K").Value = Array("", "ColD", "", "ColF", _
                        "", "ColH", "ColI", "ColJ", "ColK")
                End With
            End With
        End If
    Next r

    MsgBox "Skimmer-insertion complete.", vbInformation

End Sub

争论不休

Sub InsertSkimmersTest()
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rng2 As Range:  Set rng2 = ws.Range("A1").CurrentRegion
    InsertSkimmers rng2
End Sub

Sub InsertSkimmers(ByVal rg As Range)
    
    Dim r As Long
    For r = rg.Rows.Count To 2 Step -1
        If LCase(rg.Cells(r, "K").Value) Like "*skimmer*" Then
            With rg.Rows(r).Offset(1)
                .Insert xlShiftDown, xlFormatFromLeftOrAbove
                With .Offset(-1)
                    .Columns("A:B").Value = .Offset(-1).Columns("A:B").Value
                    .Columns("C:K").Value = Array("", "ColD", "", "ColF", _
                        "", "ColH", "ColI", "ColJ", "ColK")
                End With
            End With
        End If
    Next r

    MsgBox "Skimmer-insertion complete.", vbInformation

End Sub