在特定文本后插入一行 - VBA

Question

我想在找到特定文本后在 Excel 电子表格中插入一行是一列。文本出现N次，需要在最后一次出现后插入新行。

我所拥有的一个例子

ColumnA
TextA
TextA
TextA
TextA
TextB
TextB
TextB
TextB
TextC
TextC
TextC
TextC

每次执行宏时，我需要在上次出现TextA、TextB和TextC之后插入一个新行。

有没有办法找出给定文本在一列中出现的最大次数？这样就可以为所欲为。

编辑：

我试图计算每个文本出现的次数并将这个值分配给一个变量：

Sub count()
Dim A As Integer
A = Application.WorksheetFunction.CountIf(Range("B:B"), "TextA")

Dim B As Integer
B = Application.WorksheetFunction.CountIf(Range("B:B"), "TextB")

Dim C As Integer
C = Application.WorksheetFunction.CountIf(Range("B:B"), "TextC")
End Sub

之后我尝试插入一个新行

Sub insert_row ()
    Rows("4+A:4+A").Select 'The number 4 is the first row `TextA` appears. So 4+A where I need to insert my new row.
    Selection.Insert Shift:=xlDown
End Sub

使用此代码我必须解决问题

1 - A 不仅有 TextA、TextB 和 TextC 文本要查找。实际上，我在专栏中有 30 种不同的文字。

2 - 子 insert_row () 不起作用。

Answer 1

只要我的两分钱，如果性能对你有任何价值。

以下代码要求您进入 VBE 的工具 ► 参考并添加 Microsoft Scripting Runtime。这包含 Scripting.Dictionary 的库定义。但是，如果您使用 CreateObject("Scripting.Dictionary")，则不需要库引用。

使用此代码，您可以使用脚本字典在 A 列中查找不同的值，然后找到该值的最后一次使用时间，并在下方插入一行。

Sub findlastItem()

Dim unique As Object
Dim firstcol As Variant

Set unique = CreateObject("Scripting.Dictionary")
 
With Worksheets("sheet1")
 
 firstcol = .Range(.Cells(2, "A"), .Cells(Rows.Count, "A").End(xlUp)).Value2
 
 For v = LBound(firstcol, 1) To UBound(firstcol, 1)
 If Not unique.Exists(firstcol(v, 1)) Then _
                unique.Add Key:=firstcol(v, 1), Item:=vbNullString
      Next v
  End With
 
  For Each myitem In unique
     findAndInsertRow myitem
  Next

 End Sub


Sub findAndInsertRow(findwhat As Variant)

    Dim FindString As String
    Dim Rng As Range
    Dim LastRange As Range
    
    listOfValues = Array(findwhat)

    If Trim(findwhat) <> "" Then
        With Sheets("Sheet1").Range("A:A")

                Set Rng = .Find(What:=listOfValues(i), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False)
                If Not Rng Is Nothing Then
                    Rng.Offset(1, 0).Insert
                 End If
            
        End With
    End If

Answer 2

这会遍历单元格并在每次单元格不等于其下方的单元格并且单元格不为空白时添加一行。

 Sub Insert()
  Dim LastRow As Long
  Dim Cell As Range

Application.ScreenUpdating = False


    LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(-4162).Row

    For Each Cell In Sheets("Sheet1").Range("A1:A" & LastRow)
        If Cell.Value <> Cell.Offset(1, 0) Then
            If Cell.Value <> "" Then
                Sheets("Sheet1").Rows(Cell.Row + 1).Insert
            End If
        End If
    Next Cell

Application.ScreenUpdating = True


End Sub