Вставить строку в отфильтрованные строки на основе критериев

Question

Я пытаюсь выяснить, что не так с моим кодом.Я пытаюсь отфильтровать на основе столбца L2 в последнюю строку и добавить разрывы на основе изменений критериев с A2 на последнюю строку отфильтрованного столбца.

Но он работает и для скрытых рядов.Я думаю, что это что-то простое, что я упускаю, но любая помощь или толчок в правильном направлении будут с благодарностью!

Вот мой код:

ActiveSheet.Range("A1:O" & lr).AutoFilter Field:=12, Criteria1:="Article State Change"
Set rng = Range("A2:A" & lr).SpecialCells(xlCellTypeVisible)
    irow = rng.Row
    icol = rng.Column
Do
If Cells(irow + 1, icol) <> Cells(irow, icol) Then
   Cells(irow + 1, icol).EntireRow.Insert shift:=xlDown
   Cells(irow + 1, icol).EntireRow.Interior.Color = RGB(192, 192, 192)
   irow = irow + 2
Else
   irow = irow + 1
End If
'
Loop While Not Cells(irow, icol).Text = ""

Answer 1

Представьте себе следующие данные:

Если вы теперь фильтруете по Article State Change, тогда ваш .SpecialCells(xlCellTypeVisible) даст диапазон, состоящий из 4 несмежных областей {1}, {7,8}, {11} and {17}. Поэтому сначала вы должны пройти по каждой из этих областей, а затем пройти по всем строкам в каждой области (используя второй цикл).

Кроме того, поскольку вставка строк изменяет номера строк ниже позиции вставки, вам необходимо выполнить цикл от нижней части ваших данных до верхней.

Option Explicit

Public Sub FilterAndInsert()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet 'better define by name: ThisWorkbook.Worksheets("MySheet")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ws.Range("A1:O" & LastRow).AutoFilter Field:=12, Criteria1:="Article State Change"

    Dim FilteredData As Range
    Set FilteredData = ws.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)

    Dim iArea As Long
    Dim iRow As Long
    For iArea = FilteredData.Areas.Count To 1 Step -1 'loop from last to first area
        For iRow = FilteredData.Areas(iArea).Rows.Count To 1 Step -1 'loop from last row to first row in each area
            With FilteredData.Areas(iArea).Rows(iRow) '<-- this represents the current row we are in the loop
                .Offset(RowOffset:=1).EntireRow.Insert Shift:=xlDown
                .Offset(RowOffset:=1).EntireRow.Interior.Color = RGB(192, 192, 192)
            End With
        Next iRow
    Next iArea

    'remove filters
    ws.Range("A1:O" & LastRow).AutoFilter
End Sub

Таким образом, результат будет: