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

Question

我需要在包含关键字“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

Answer 1

插入范围行并填充数据

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

紧凑型

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