Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Удалить пустые строки и столбцы со всех листов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить пустые строки и столбцы со всех листов (Макросы/Sub)
Удалить пустые строки и столбцы со всех листов
Gjlhzl Дата: Вторник, 07.03.2023, 23:16 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 110
Репутация: 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]
 
Ответить
СообщениеДоброй ночи всем. Просьба помочь доработать макрос что бы удалял пустые строки столбцы со всех листов книги..
[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]

Автор - Gjlhzl
Дата добавления - 07.03.2023 в 23:16
Gustav Дата: Среда, 08.03.2023, 01:01 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2732
Репутация: 1136 ±
Замечаний: 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]


МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Среда, 08.03.2023, 01:09
 
Ответить
СообщениеЧо-то как-то сложновато у Вас. Лучше удалять с конца, т.е. от больших строк/столбцов к меньшим - так меньше шансов запутаться в их нумерации. Считать пустоты, наверное, экономичнее только в части строки/столбца, проходящей внутри 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]

Автор - Gustav
Дата добавления - 08.03.2023 в 01:01
Gjlhzl Дата: Среда, 08.03.2023, 01:11 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 110
Репутация: 0 ±
Замечаний: 0% ±

Gustav, а че то работает только на активном листе...а не на всех....?
 
Ответить
СообщениеGustav, а че то работает только на активном листе...а не на всех....?

Автор - Gjlhzl
Дата добавления - 08.03.2023 в 01:11
Gustav Дата: Среда, 08.03.2023, 01:14 | Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2732
Репутация: 1136 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Уже на всех. Еще раз скопируйте весь мой код и запустите DeleteEmpty_AllSheets.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеУже на всех. Еще раз скопируйте весь мой код и запустите DeleteEmpty_AllSheets.

Автор - Gustav
Дата добавления - 08.03.2023 в 01:14
Gjlhzl Дата: Среда, 08.03.2023, 01:18 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 110
Репутация: 0 ±
Замечаний: 0% ±

Gustav, спасибо! все работает
 
Ответить
СообщениеGustav, спасибо! все работает

Автор - Gjlhzl
Дата добавления - 08.03.2023 в 01:18
Gjlhzl Дата: Среда, 08.11.2023, 18:04 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 110
Репутация: 0 ±
Замечаний: 0% ±

Gustav, Вечер добрый, а посмотрите пожалуйста почему ваш код из сообщ2 не работает?
взгляните пример
К сообщению приложен файл: 3921761.xlsb (116.3 Kb)
 
Ответить
СообщениеGustav, Вечер добрый, а посмотрите пожалуйста почему ваш код из сообщ2 не работает?
взгляните пример

Автор - Gjlhzl
Дата добавления - 08.11.2023 в 18:04
Gustav Дата: Среда, 08.11.2023, 19:15 | Сообщение № 7
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2732
Репутация: 1136 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
почему ваш код из сообщ2 не работает?

Почему не работает? Работает. У вас там просто практически нет пустых строк/столбцов, которые можно было бы удалить, вот и кажется, что ничего не происходит. Не верите - пройдитесь в отладчике по шагам, нажимая F8.

Если вы про строку 13 на всех листах, которая визуально кажется совсем пустой, то она не удаляется потому, что в ячейках C13 и D13 находится какая-то невидимая хрень нулевой длины, которую, тем не менее, чувствует функция СЧЁТЗ (CountA в VBA). Очистите принудительно эти ячейки клавишей Delete и повторите запуск макроса - строка удалится.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
Сообщение
почему ваш код из сообщ2 не работает?

Почему не работает? Работает. У вас там просто практически нет пустых строк/столбцов, которые можно было бы удалить, вот и кажется, что ничего не происходит. Не верите - пройдитесь в отладчике по шагам, нажимая F8.

Если вы про строку 13 на всех листах, которая визуально кажется совсем пустой, то она не удаляется потому, что в ячейках C13 и D13 находится какая-то невидимая хрень нулевой длины, которую, тем не менее, чувствует функция СЧЁТЗ (CountA в VBA). Очистите принудительно эти ячейки клавишей Delete и повторите запуск макроса - строка удалится.

Автор - Gustav
Дата добавления - 08.11.2023 в 19:15
Gjlhzl Дата: Среда, 08.11.2023, 20:19 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 110
Репутация: 0 ±
Замечаний: 0% ±

Gustav, да работает. Извиняюсь
А по аналогии можно макрос сделать что бы удалял все скрытые строки и столбцы на всех листах? ща создам тему.
 
Ответить
СообщениеGustav, да работает. Извиняюсь
А по аналогии можно макрос сделать что бы удалял все скрытые строки и столбцы на всех листах? ща создам тему.

Автор - Gjlhzl
Дата добавления - 08.11.2023 в 20:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Удалить пустые строки и столбцы со всех листов (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!