VBA excel 用于在匹配可变数量的匹配值下方插入整行的代码

Question

我是编写 vba 代码的新手，希望得到一些指导并帮助我编写基本宏。我按三个标题对数据进行排序，然后通过在列 "B" 中插入一个空白行来匹配值来分隔数据，从 B2 行开始到最后一行结束。这些对的数量可变，即可能是 none，一个、两个或三个匹配值，但我只想将它们分组并在最后一个匹配值下方插入一行。有谁可以帮助我吗？

'Sub BetterFilter()
Dim CDpos As Worksheet
Set CDpos = Worksheets("CD positions with red bars")
AutoFilter = False
FilterMode = False
'the headers are from "A1:CT1"
Range("A1:CT2").Select
CDpos.AutoFilter.Sort. _
SortFields.Clear
CDpos.AutoFilter.Sort. _
'B2 is the first range i want to filter etc'
SortFields.Add Key:=Range("B2:B2").End(xlDown), SortOn:=xlSortOnValues,Order:= _
    xlAscending, DataOption:=xlSortNormal
CDpos.AutoFilter.Sort. _
    SortFields.Add Key:=Range("M2:M2").End(xlDown), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
CDpos.AutoFilter.Sort. _
    SortFields.Add Key:=Range("CE2:CE2").End(xlDown), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal
With CDpos.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply

'this is where i have problems and i want to bunch all my matched values in row B and insert a row below the last match value for each grouping' 
    For i = 1 To 2
    If Range("B2" & i).Value = Range("B2" & i + 1).Value Then
    Range(B2, & i + 1).EntireRow.Insert

End If
Next
End With
End Sub'

Answer 1

我会选择类似的东西：

Dim cell As Range
For Each cell In Range("B2", Cells(Rows.Count, "B").End(xlUp).Address)
'loop from B1 to the last used cell in column B
    If cell.Offset(-1, 0).Value2 <> cell.Value2 And cell.Offset(-1, 0) <> vbNullString Then cell.EntireRow.Insert
    'if the cell above is different and not null then it adds a row above
Next cell

并将 "B2" 更改为您第一次使用的单元格。

VBA excel 用于在匹配可变数量的匹配值下方插入整行的代码

VBA excel code to insert an entire row below matching a variable number of matching values

excel

vba

matching