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