Доброй ночи всем. Просьба помочь доработать макрос что бы удалял пустые строки столбцы со всех листов книги.. [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]
Доброй ночи всем. Просьба помочь доработать макрос что бы удалял пустые строки столбцы со всех листов книги.. [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
Чо-то как-то сложновато у Вас. Лучше удалять с конца, т.е. от больших строк/столбцов к меньшим - так меньше шансов запутаться в их нумерации. Считать пустоты, наверное, экономичнее только в части строки/столбца, проходящей внутри 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]
Чо-то как-то сложновато у Вас. Лучше удалять с конца, т.е. от больших строк/столбцов к меньшим - так меньше шансов запутаться в их нумерации. Считать пустоты, наверное, экономичнее только в части строки/столбца, проходящей внутри 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
Почему не работает? Работает. У вас там просто практически нет пустых строк/столбцов, которые можно было бы удалить, вот и кажется, что ничего не происходит. Не верите - пройдитесь в отладчике по шагам, нажимая F8.
Если вы про строку 13 на всех листах, которая визуально кажется совсем пустой, то она не удаляется потому, что в ячейках C13 и D13 находится какая-то невидимая хрень нулевой длины, которую, тем не менее, чувствует функция СЧЁТЗ (CountA в VBA). Очистите принудительно эти ячейки клавишей Delete и повторите запуск макроса - строка удалится.
Почему не работает? Работает. У вас там просто практически нет пустых строк/столбцов, которые можно было бы удалить, вот и кажется, что ничего не происходит. Не верите - пройдитесь в отладчике по шагам, нажимая F8.
Если вы про строку 13 на всех листах, которая визуально кажется совсем пустой, то она не удаляется потому, что в ячейках C13 и D13 находится какая-то невидимая хрень нулевой длины, которую, тем не менее, чувствует функция СЧЁТЗ (CountA в VBA). Очистите принудительно эти ячейки клавишей Delete и повторите запуск макроса - строка удалится.Gustav
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
