Требуется удалить все пустые строки и столбцы на листе Excel, в т.ч. расчерченные границами, с форматами, залитые цветом, скопированные с другого листа и не заполненные и т.д.
Зачем это нужно?
Мне понадобилось для того, чтобы с помощью Power Query свести в одну сводную таблицу 50 однотипных вкладок, в которых МОП несколько лет подряд по месяцам вносили все заказы клиентов. При этом объединение через Power Query работает при условии, что:
- у таблиц на всех обрабатываемых листах одинаковая шапка (некоторые листы на выбор можно пропустить);
- на листах с исходными таблицами нет лишних данных. На одном листе — одна таблица.
- Последняя использованная ячейка листа должна быть последней ячейкой таблицы с данными. Проверка с помощью Ctrl+End. (Вот на этом этапе макрос и понадобился, т.к. МОПы в процессе творчества уходили кто куда, далеко за пределы данных таблицы. А когда в файле одного менеджера 50 вкладок, а менеджеров много, удалять пустые строки/столбцы долго и скучно).
Инструкция по сборке сводной по нескольким диапазонам из разных листов есть у Николая Павлова. Инструкция по сборке сводной одновременно из разных файлов Excel — здесь (пароль 123).
Макрос для отдельного листа Excel
Макрос обрабатывает фактически занятый диапазон (
UsedRange
), а не все строки листа.Отключаются обновления экрана и автовычисления .
Безопасно перезапускается даже на большом листе.
За счет этого выполнение происходит очень быстро.
Option Explicit
Sub УдалитьПустыеСтрокиИСтолбцы_Быстро()
Dim ws As Worksheet
Dim r As Long, c As Long
Dim lastRow As Long, lastCol As Long
Dim dummy As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set ws = ActiveSheet
' Определяем последнюю реально занятую строку и столбец
With ws.UsedRange
lastRow = .Rows(.Rows.Count).Row
lastCol = .Columns(.Columns.Count).Column
End With
' Удаляем пустые строки снизу вверх
For r = lastRow To 1 Step -1
If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
ws.Rows(r).Delete
End If
Next r
' Удаляем пустые столбцы справа налево
For c = lastCol To 1 Step -1
If Application.WorksheetFunction.CountA(ws.Columns(c)) = 0 Then
ws.Columns(c).Delete
End If
Next c
' Обновить UsedRange (восстановить правильную позицию Ctrl+End)
Set dummy = ws.UsedRange
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Пустые строки и столбцы удалены. Область данных обновлена.", vbInformation
End Sub
Этот же макрос для всех листов книги
Обходит все листы, включая скрытые.
Пропускает полностью пустые листы.
Защищён от сбоев на ‘проблемных’ листах (
On Error Resume Next
+GoTo NextSheet
).
Option Explicit
Sub УдалитьПустыеСтрокиИСтолбцы_НаВсехЛистах()
Dim ws As Worksheet
Dim r As Long, c As Long
Dim lastRow As Long, lastCol As Long
Dim dummy As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
For Each ws In ThisWorkbook.Worksheets
With ws
On Error Resume Next ' на случай проблем с пустыми листами
' Определяем UsedRange (активный диапазон)
If Application.WorksheetFunction.CountA(.Cells) = 0 Then GoTo NextSheet ' пропустить полностью пустой лист
With .UsedRange
lastRow = .Rows(.Rows.Count).Row
lastCol = .Columns(.Columns.Count).Column
End With
' Удаляем пустые строки снизу вверх
For r = lastRow To 1 Step -1
If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
ws.Rows(r).Delete
End If
Next r
' Удаляем пустые столбцы справа налево
For c = lastCol To 1 Step -1
If Application.WorksheetFunction.CountA(ws.Columns(c)) = 0 Then
ws.Columns(c).Delete
End If
Next c
' Принудительное обновление UsedRange
Set dummy = .UsedRange
NextSheet:
On Error GoTo 0
End With
Next ws
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "Обработка завершена: пустые строки и столбцы удалены на всех листах.", vbInformation
End Sub
А как добавить макрос?
Если что, напомним как добавить макрос и заставить его работать:
1) В Excel, Word, PP и т.д., нажать Alt + F11, или кнопку Visual Basic на вкладке Разработчик. В меню редактора VBA вставить новый модуль Insert — Module
и вставить в окошко редактора расположенный выше код, далее можно сохранить код, нажав Ctrl + S и закрыть окно VBA (Alt + F4);
2) Нажать Alt + F8, выбрать макрос и нажать кнопку Выполнить.