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 - Sub 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

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

2 个答案: