Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Скрытие строк по условию, Скрытие строк по условию в выделенном диапазоне
 
#1
17.05.2024 16:30:53

Уважаемые форумчане, добрый день!

Мучаюсь второй день, не могу реализовать задачу.

Макрос на кнопке «Скрыть пустые» скрывает все строки, начиная с 30 строки и до конца таблицы по при условии пустых ячеек в определенных столбцах

Код
Sub СкрытьПустые()
Dim i&
Application.ScreenUpdating = False
    For i = 30 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 30 строки
    'Далее определяем какие диапазоны столбцов мы отслеживаем, если во всех указанных диапазонах пусто, то идет скрытие строки
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
     Rows(i).EntireRow.Hidden = True
    End If
    Next
Application.ScreenUpdating = True
End Sub

Кнопка «Отобразить все» возвращает все обратно.

Код
Sub ОтобразитьПустые()
Rows("30:9999").Hidden = False  'Показать скрытые строки в диапазоне 

End Sub
При заполнении данными макрос выполняется очень
долго (несколько минут). Решил облегчить задачу и выполнять скрытие строк
только в указанном через форму диапазоне по выбору пользователя – кнопка «Скрыть
пустые строки диапазона»
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. Почему так не понятно. Rows("i1:i2") не работает
    Application.ScreenUpdating = True

End Sub

Скрытие строк работает, но только внедрить условия (объединить эти два кода) не получается

Пробовал так
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
'    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 7 строки
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. 
    End If
'    Next
Application.ScreenUpdating = True

End Sub
не работает.

Прошу помочь с решением данной проблемы.
Если можно подскажите еще пожалуйста как можно заменить названия столбцов на "Поименованный диапазон" (столбцы часто меняются и приходится каждый раз править код)

Заранее спасибо.
 
 
 
#2
18.05.2024 05:13:46
VadimSh, Доброго времени суток. Если я вас понял то давайте попробуем следуйщий код:
Нажми и увидишь код

По поводу
Цитата
VadimSh написал:
столбцы часто меняются и приходится каждый раз править код
Создаём дополнительный лист где указываем какие столбцы берём в условие. Подробнее разберётесь в моём файле примере. Удачи.
Изменено: MikeVol - 23.05.2024 16:19:31 (Спрятал код под Спойлером)
 
 
 
#3
21.05.2024 15:39:22
MikeVol, спасибо за ответ, но это не решает мою проблему. Может я плохо описал задачу. В моем файле кнопка "Скрыть пустые"
Код
Sub СкрытьПустые()
Dim i&
Application.ScreenUpdating = False
    For i = 30 To Cells(Rows.Count, 1).End(xlUp).Row   'Определяем что скрытие пустых строк начнется с 30 строки
    'Далее определяем какие диапазоны столбцов мы отслеживаем, если во всех указанных диапазонах пусто, то идет скрытие строки
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
     And WorksheetFunction.CountA(Range("L" & i & ":L" & i)) = 0 _
     And WorksheetFunction.CountA(Range("N" & i & ":P" & i)) = 0 _
     And WorksheetFunction.CountA(Range("R" & i & ":R" & i)) = 0 _
     And WorksheetFunction.CountA(Range("T" & i & ":V" & i)) = 0 _
     And WorksheetFunction.CountA(Range("X" & i & ":Y" & i)) = 0 _
     And WorksheetFunction.CountA(Range("AA" & i & ":AA" & i)) = 0 Then
     Rows(i).EntireRow.Hidden = True
    End If
    Next
Application.ScreenUpdating = True
End Sub
скрывает все строки, начиная с 30 при условии что данные в столбцах  "D", "Е", "F", "G", H" ... и т.д. не пустые. Все работает правильно, но при большом объеме данных скрытие выполняется очень долго (500 строк - более 30 секунд). А данная операция выполняется часто.

Для ускорения решил скрывать и отображать строки только в указанном пользователем диапазоне строк. Для этого на кнопку "Скрыть пустые строки диапазона" вывел форму запроса "UserForm", которая предлагает пользователю выделить необходимый диапазон строк, где необходимо скрыть строки. При выделении строк и подтверждении выполняется
Код
Sub СкрытьПустыеДиапазона2()
    Dim i1 As Long, i2 As Long
    Application.ScreenUpdating = False
    i1 = Selection.Cells(1).Row  'Определяем переменную i1 - первая строка выделенного диапазона
    i2 = Selection.Cells(Selection.Cells.Count).Row   'Определяем переменную i2 - последняя строка выделенного диапазона
    Rows(i1).Resize(i2 - i1 + 1).Hidden = True 'Скрываются строки в диапазоне. 
    Application.ScreenUpdating = True

End Sub
Все работает, но скрываются все строки выделенного диапазона, но мне нужно что-бы скрывались только строки из выделенного диапазона с условием, что данные в столбцах  "D", "Е", "F", "G", H" ... и т.д. (как в первой коде) не пусты. То есть мне надо в 2-й код внедрить условия выполнения из 1-го кода  
 
 
 
#4
21.05.2024 15:50:40
Цитата
написал:
По поводу Цитата VadimSh  написал:столбцы часто меняются и приходится каждый раз править кодСоздаём дополнительный лист где указываем какие столбцы берём в условие. Подробнее разберётесь в моём файле примере. Удачи.
И по второму вопросу решение не подходит. Нет большой разницы править названия столбцов (для выполнения условий отбора на скрытие строк) в коде или в ячейке на отдельном листе. Необходимо чтобы при добавлении/удалении/перемещении столбцов пользователем код работал правильно. Решение наверное только в создании имен столбцов "Именованный диапазон", но как это внедрить в код?
Код
     If WorksheetFunction.CountA(Range("D" & i & ":H" & i)) = 0 _
     And WorksheetFunction.CountA(Range("J" & i & ":J" & i)) = 0 _
Спасибо заранее
 
 
 
#5
22.05.2024 04:30:07
Цитата
VadimSh написал:
Для ускорения решил скрывать и отображать строки только в указанном пользователем диапазоне строк.
Может быть так?

???
 
 
 
#6
22.05.2024 13:59:43
Не работает: ошибки не выдает, но и ничего не скрывает
 
 
 
#7
22.05.2024 14:02:21
Файл прилагаю
 
 
 
#8
22.05.2024 15:29:17
Код
Sub HideEmptyCellInRanges()
    Dim i           As Long
    Dim RowRange As Range, cell As Range
    Dim checkedRows As Object
    Dim rangeAddress As String
    Application.ScreenUpdating = False

    If TypeName(Selection) = "Range" Then
        Set checkedRows = CreateObject("Scripting.Dictionary")

        For Each cell In Selection
            i = cell.Row
            rangeAddress = "D" & i & ":H" & i & ",J" & i & ":J" & i & ",L" & i & ":L" & i & ",N" & i & ":P" & i & _
                    ",R" & i & ":R" & i & ",T" & i & ":V" & i & ",X" & i & ":Y" & i & ",AA" & i & ":AA" & i

            If Not checkedRows.exists(i) Then
                checkedRows.Add i, True
                Set RowRange = ActiveSheet.Range(rangeAddress)

                If Application.WorksheetFunction.CountA(RowRange) = 0 Then

                    ActiveSheet.Rows(i).EntireRow.Hidden = True
                End If

            End If

        Next cell

    End If

    Set RowRange = Nothing
    Set checkedRows = Nothing
    Application.ScreenUpdating = True
End Sub
Изменено: vokilook - 22.05.2024 15:34:39
 
 
 
#9
23.05.2024 14:47:55
Цитата
написал:
КодSub HideEmptyCellInRanges()
Vokilook, большое спасибо за помощь все работает!!!

Выкладываю файл. Может кому пригодится
 
 
 
Страницы: 1
Читают тему
Наверх