在特定文本上插入行并发生 [英] Insert row base on specific text and its occurrence

问题描述

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

我正在使用以下代码：

  Sub try （）
 Dim c As Range 
对于每个c In Range（A1：A100）
如果c.Value像* COLLECTION *那么
 c.Offset（1 ，0）.EntireRow.Insert 
 End If 
下一个c 
 End Sub 
  

1. 我想让文本BALANCE在COLLECTION单元格下方，而不是空白行。




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

我的收藏和余额行在列A中

解决方案

我会使用第1列的循环，直到列 A 中的最后一行。然后，当当前单元格中的单元格值为code* COLLECTION *时，该值为true，而false则为true。因此，如果当前单元格不像* COLLECTION *但标记为true，那么当前单元格上方的最后一个单元格就像* COLLECTION *。然后，如果该单元格尚未位于BALANCE。

$ BALANCE b
$ b

  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 
设置c = .Range（A& lRow）
如果c.Value喜欢* COLLECTION *然后
 bFound = True 
 ElseIf bFound然后
 bFound = False 
如果c.Value<> BALANCE然后
 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 
循环while lRow< = lRowLast + 1 
结束
结束Sub 
  

I am using a VBA code to insert rows below based on a specific text and its occurrence .

I am using the following code to do so

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. I want to have the text BALANCE below the COLLECTION cell instead of blank row.

2. I want to insert the BALANCE row below the last COLLECTION entry, for example if there are two collections rows serially then I want to add the BALANCE row after the 2nd collection row. but with the above VBA code I am getting blank rows below to the each collection row.

My Collection and balance rows are in the column A

Before macro Image kindly check

After macro I want like this Image kindly check

解决方案

I would do this using a loop from row 1 till last filled row in column A. Then having a boolean marker which is true while the cell value in current cell is like "*COLLECTION*" but false while not. So if the current cell is not like "*COLLECTION*" but the marker is true then the last cell above the current cell was like "*COLLECTION*". Then insert a new row with "BALANCE" if that cell is not already "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

这篇关于在特定文本上插入行并发生的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！