在特定文本及其出现处插入行基

我正在使用VBA代码根据特定的文本和它的出现插入下面的行。

我正在使用下面的代码来这样做

Sub try() Dim c As Range For Each c In Range("A1:A100") If c.Value Like "*COLLECTION*" Then c.Offset(1, 0).EntireRow.Insert End If Next c End Sub 

1. 我希望文本BALANCE低于COLLECTION单元而不是空白行。

2. 我想在最后一个COLLECTION条目下插入BALANCE行，例如，如果连续有两个集合行，那么我想在第二个集合行之后添加BALANCE行。 但与上面的VBA代码，我得到空白行下面的每个收集行。

我的集合和平衡行在列A中

在macrosImage之前请好好检查一下

macros后，我想这个图像请检查

Answer 1

我会做这个使用循环从第1行到最后一列在A列填充行。 然后有一个布尔标记是真的，而当前单元格中的单元格的值是"*COLLECTION*"但是不是。 因此，如果当前单元格不是"*COLLECTION*"而是标记为真，则当前单元格上方的最后一个单元格就像"*COLLECTION*" 。 然后插入一个新的行"BALANCE"如果该单元尚未"BALANCE" 。

 Sub try() Dim c As Range Dim lRow As Long lRow = 1 Dim lRowLast As Long Dim bFound As Boolean With ActiveSheet lRowLast = .Cells(.Rows.Count, 1).End(xlUp).Row Do Set c = .Range("A" & lRow) If c.Value Like "*COLLECTION*" Then bFound = True ElseIf bFound Then bFound = False If c.Value <> "BALANCE" Then c.EntireRow.Insert lRowLast = lRowLast + 1 c.Offset(-1, 0).Value = "BALANCE" c.Offset(-1, 0).Font.Color = RGB(0, 0, 0) End If End If lRow = lRow + 1 Loop While lRow <= lRowLast + 1 End With End Sub 

Answer 2

这通常是你想要从最后一个单元格开始的情况，因为插入一行会混淆下面的所有计数器。

换句话说，每个人的优雅并不是一个好主意。 太不可预测了。 一个丑陋的，简单的步骤-1是要走的路。 就像是 ：

 Sub Macro1() For l = 100 To 1 Step -1 If Trim(Cells(l, 1)) = "COLLECTION" And Trim(Cells(l + 1, 1)) = "DEMAND" Then Rows(CStr(l + 1) & ":" & CStr(l + 1)).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Cells(l + 1, 1) = "BALANCE" End If Next l End Sub 

刚刚在EXCEL 2013上试过，似乎按你的要求工作。 不过，可能会有更优雅的解决scheme。

编辑：这个想法是以下一个：从最后一行开始（实际上，最后一行不能工作，所以一个优化可能是从prevo = ious开始），然后转到第一行_如果行睾丸是“COLLECTION”，下一个是“DEMAND”，那么你需要在它们之间插入一条“BALANCE”线。 完成2次，首先插入一个空行，然后在新创build的行中添加“BALANCE”。