Как вставить новую строку, когда значение ячейки ниже не равно значению активной ячейки

Question

Как вставить новую строку, если значение ячейки ниже не равно значению активной ячейки

просто как получить этот результат:

в настоящее время код vba:

Sub InsertBlankRowsBasedOnCellValue()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

    Col = "A"
    StartRow = 1
    BlankRows = 1

        LastRow = Cells(Rows.Count, Col).End(xlUp).Row

        Application.ScreenUpdating = False

        With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) <> LastRow Then
.Cells(R, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Answer 1

Условие

If .Cells(R, Col) <> LastRow Then

странно смешивает значения ячеек и номера строк.

Здесь вы должны просто проверить, находитесь ли вы на последнем минимуме. Тогда вы пока не можете сравнивать его ни с чем, используйте следующее условие, чтобы пропустить этот случай:

If R <> LastRow Then

Для всех остальных строк вы должны сравнить два последовательных значения ячеек

If .Cells(R, Col).Value <> .Cells(R + 1, Col).Value Then

Итак, вот весь код:

Dim Col As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "A"
StartRow = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row
With ActiveSheet
    Application.ScreenUpdating = False
    For R = LastRow To StartRow + 1 Step -1
        If R <> LastRow Then
            If .Cells(R, Col).Value <> .Cells(R + 1, Col).Value Then
                .Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
            End If
        End If
    Next R
End With
Application.ScreenUpdating = True

End Sub