Удалить пустые строки и столбцы со всех листов

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить пустые строки и столбцы со всех листов (Макросы/Sub)

Gjlhzl

Дата: Вторник, 07.03.2023, 23:16 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 48

Репутация: 0 ±

Замечаний: 0% ±

Доброй ночи всем. Просьба помочь доработать макрос что бы удалял пустые строки столбцы со всех листов книги..
[vba]

Код

Sub DeleteEmpty()
    Dim r As Long, rng As Range

    'удаляем пустые строки
    For r = 1 To ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
        If Application.CountA(Rows(r)) = 0 Then
            If rng Is Nothing Then Set rng = Rows(r) Else Set rng = Union(rng, Rows(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete
    Set rng = Nothing

    'удаляем пустые столбцы
    For r = 1 To ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count
        If Application.CountA(Columns(r)) = 0 Then
            If rng Is Nothing Then Set rng = Columns(r) Else Set rng = Union(rng, Columns(r))
        End If
    Next r
    If Not rng Is Nothing Then rng.Delete

End Sub

[/vba]

Ответить

Gustav

Дата: Среда, 08.03.2023, 01:01 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2356

Репутация: 961 ±

Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1

Чо-то как-то сложновато у Вас. Лучше удалять с конца, т.е. от больших строк/столбцов к меньшим - так меньше шансов запутаться в их нумерации. Считать пустоты, наверное, экономичнее только в части строки/столбца, проходящей внутри UsedRange, а не через весь рабочий лист. Ну, и Union как-то тоже тяжеловесно здесь выглядит - "ф топку его!" Итого в сухом остатке - две процедуры:
[vba]

Код

Option Explicit

Sub DeleteEmpty_AllSheets()
    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets
        DeleteEmpty_ForOneSheet wks
    Next wks
End Sub

Sub DeleteEmpty_ForOneSheet(wks As Worksheet)

    Dim wf   As WorksheetFunction
    Dim i    As Long
    Dim iMin As Long
    Dim iMax As Long

    Set wf = WorksheetFunction

    'удаляем пустые строки (в обратном цикле)
    iMin = wks.UsedRange.Row
    iMax = iMin - 1 + wks.UsedRange.Rows.Count
    For i = iMax To iMin Step -1
        If wf.CountA(wks.UsedRange.Rows(i - iMin + 1)) = 0 Then wks.Rows(i).Delete
    Next i

    'удаляем пустые столбцы (в обратном цикле)
    iMin = wks.UsedRange.Column
    iMax = iMin - 1 + wks.UsedRange.Columns.Count
    For i = iMax To iMin Step -1
        If wf.CountA(wks.UsedRange.Columns(i - iMin + 1)) = 0 Then wks.Columns(i).Delete
    Next i
End Sub

[/vba]