выделите строки с объединенными ячейками и удалите их (строки)

Question

Поиск в Google Я нашел процедуру для выделения объединенных ячеек на активном листе:

Sub DeleteRows()
    Dim x As Range
    For Each x In ActiveSheet.UsedRange
        If x.MergeCells Then
            x.Interior.ColorIndex = 8
            ActiveCell.EntireRow.Delete
        End If
    Next
End Sub

Поэтому я добавил оператор ActiveCell.EntireRow.Delete, чтобы удалить строку, которая в данный момент повторяется.

Где я ошибаюсь?

Меня не волнует выделение слитых ячеек.Конечная цель - просто удалить любую строку, в которой есть объединенная ячейка.

Answer 1

При удалении строк всегда удаляйте снизу вверх или а) вы рискуете удалить следующую ячейку, которую хотите исследовать, и б) рискуете пропустить строку, которая появляется вместо замещенной строки.

Sub DeleteRows()
    Dim r as long, c as long

    with ActiveSheet.UsedRange
        'work backwards through the rows
        For r = .rows.count to 1 step -1
            'work forwards through the columns
            For c = 1 to .columns.count
                If .cells(r, c).MergeCells Then
                    'once a merged cell is found, delete then go immediately to the next row
                    .cells(r, c).EntireRow.Delete
                    exit for
                End If
            next c
        Next r
    end with

End Sub

Answer 2

Быстрый способ сделать это - найти все объединенные ячейки, а затем удалить их за один раз: хороший способ сделать это - использовать range.find, используя объединенный формат ячеек, а затем объединить найденные диапазоны

Следующий код перебирает объединенные диапазоны и создает объединение, затем выбирает целые строки

Sub SelectMerge()
    Dim rng As Range, rngUnion As Range, Test As Range
    Dim ws As Worksheet: Set ws = ActiveSheet

    With Application.FindFormat
        .Clear
        .MergeCells = True
    End With

    With ws.UsedRange
        Set rng = .Find("", SearchFormat:=True)
        Do
            If Not rngUnion Is Nothing Then Set rngUnion = Application.Union(rng, rngUnion)
            If rngUnion Is Nothing Then Set rngUnion = rng
            If rng Is Nothing Then Exit Do
            Set rng = .Find("", After:=rng, SearchFormat:=True)
        Loop While Application.Intersect(rng, rngUnion) Is Nothing
    End With
    If Not rngUnion Is Nothing Then rngUnion.EntireRow.Select 'rngUnion.EntireRow.Delete

End Sub

Answer 3

Выясните все объединенные диапазоны ячеек, разбейте их и удалите за один раз.

---

Sub DeleteRows()
    Dim x As Range
    Dim rngDelete As Range
    For Each x In ActiveSheet.UsedRange
        If x.MergeCells Then
            If rngDelete Is Nothing Then
                Set rngDelete = x
            Else
                Set rngDelete = Union(rngDelete, x)
            End If
        End If
    Next
    If Not rngDelete Is Nothing Then
        rngDelete.EntireRow.Delete
    End If
End Sub