Здравствуйте! Необходим макрос, который будет проверять определенный диапазон ячеек и скрывать пустые строки если в них нет данных. В соседней теме был предложен код, скрывающий строки по условию определенного столбца. Меня интересует именно условие диапазона. Приложил файл. Для примера, диапазон B2:E4, т.е. должна быть скрыта только строка 5 т.к. она пустая. [vba]
Код
Private Sub CommandButton1_Click() Dim i& Application.ScreenUpdating = False For i = 8 To Cells(Rows.Count, 3).End(xlUp).Row If Range("I" & i).Value = "" And Range("J" & i).Value = "" And Range("K" & i).Value = "" Then Rows(i).EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
[/vba]
Здравствуйте! Необходим макрос, который будет проверять определенный диапазон ячеек и скрывать пустые строки если в них нет данных. В соседней теме был предложен код, скрывающий строки по условию определенного столбца. Меня интересует именно условие диапазона. Приложил файл. Для примера, диапазон B2:E4, т.е. должна быть скрыта только строка 5 т.к. она пустая. [vba]
Код
Private Sub CommandButton1_Click() Dim i& Application.ScreenUpdating = False For i = 8 To Cells(Rows.Count, 3).End(xlUp).Row If Range("I" & i).Value = "" And Range("J" & i).Value = "" And Range("K" & i).Value = "" Then Rows(i).EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
Private Sub CommandButton1_Click() Dim i& Application.ScreenUpdating = False For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountA(Range("B" & i & ":E" & i)) = 0 Then Rows(i).EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Private Sub CommandButton1_Click() Dim i& Application.ScreenUpdating = False For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row If WorksheetFunction.CountA(Range("B" & i & ":E" & i)) = 0 Then Rows(i).EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
Подскажите, схожая задача. Но строк будет под 500. Проверить нужно диапазон A10:B500. так как в строках прописано правила условного форматирования и еще формулы, то вышеподсказаный код очень долго исполняется, секунд 30 пока все пустые скроет проходит. Есть способ быстрее скрыть? Строки с записью идут последовательно, если последняя запись будет на 200 строке, то с 201 по 500 строки будут пустыми.
Подскажите, схожая задача. Но строк будет под 500. Проверить нужно диапазон A10:B500. так как в строках прописано правила условного форматирования и еще формулы, то вышеподсказаный код очень долго исполняется, секунд 30 пока все пустые скроет проходит. Есть способ быстрее скрыть? Строки с записью идут последовательно, если последняя запись будет на 200 строке, то с 201 по 500 строки будут пустыми.Александр7034
Сообщение отредактировал Александр7034 - Четверг, 23.03.2023, 15:48
Поскольку файла Вашего нет, приходится догадываться [vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 r0_ = 10 Rows(r0_).Resize(Rows.Count - r0_).EntireRow.Hidden = 0 '=== r10_ = Cells(Rows.Count, 1).End(3).Row r11_ = Cells(Rows.Count, 2).End(3).Row If r10_ > r11_ Then r1_ = r10_ Else r1_ = r11_ End If '=== ' Или просто 'r1_=500 '=== nr_ = r1_ - r0_ + 1 ar_ = Cells(r0_, 1).Resize(nr_, 2).Value For i = 1 To nr_ If ar_(i, 1) = "" Then If ar_(i, 2) = "" Then Exit For End If End If Next i Rows(r0_ + i - 1).Resize(nr_ - i + 1).EntireRow.Hidden = True Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Поскольку файла Вашего нет, приходится догадываться [vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 r0_ = 10 Rows(r0_).Resize(Rows.Count - r0_).EntireRow.Hidden = 0 '=== r10_ = Cells(Rows.Count, 1).End(3).Row r11_ = Cells(Rows.Count, 2).End(3).Row If r10_ > r11_ Then r1_ = r10_ Else r1_ = r11_ End If '=== ' Или просто 'r1_=500 '=== nr_ = r1_ - r0_ + 1 ar_ = Cells(r0_, 1).Resize(nr_, 2).Value For i = 1 To nr_ If ar_(i, 1) = "" Then If ar_(i, 2) = "" Then Exit For End If End If Next i Rows(r0_ + i - 1).Resize(nr_ - i + 1).EntireRow.Hidden = True Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
Поскольку файла Вашего нет, приходится догадываться
Ваша интуиция не подвела и код сработал в моем файле и скрытие быстро происходит. Спасибо за подсказку, использовал r1_=500, так как нужно было четко ограничивать до какой строки можно скрывать. Но тут мой косяк вышел, начал проверять на практике с готовыми данными (эти строки копируются с другого файла), а среди массива данных оказываются все же попадаются пустые строки. Соответственно после первой же строки где ячейки в столбце "A" и "B" пустые, все остальное дальше скрывается.
Поскольку файла Вашего нет, приходится догадываться
Ваша интуиция не подвела и код сработал в моем файле и скрытие быстро происходит. Спасибо за подсказку, использовал r1_=500, так как нужно было четко ограничивать до какой строки можно скрывать. Но тут мой косяк вышел, начал проверять на практике с готовыми данными (эти строки копируются с другого файла), а среди массива данных оказываются все же попадаются пустые строки. Соответственно после первой же строки где ячейки в столбце "A" и "B" пустые, все остальное дальше скрывается.Александр7034
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 r0_ = 10 r1_ = 500 nr_ = r1_ - r0_ + 1 Rows(r0_).Resize(nr_).EntireRow.Hidden = 0 ar_ = Cells(r0_, 1).Resize(nr_, 2).Value For i = nr_ To 1 Step -1 If ar_(i, 1) <> "" Then Exit For Else If ar_(i, 2) <> "" Then Exit For End If End If Next i Rows(r0_ + i).Resize(nr_ - i).EntireRow.Hidden = True Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Тогда цикл снизу вверх [vba]
Код
Sub tt() Application.ScreenUpdating = 0 Application.Calculation = 3 r0_ = 10 r1_ = 500 nr_ = r1_ - r0_ + 1 Rows(r0_).Resize(nr_).EntireRow.Hidden = 0 ar_ = Cells(r0_, 1).Resize(nr_, 2).Value For i = nr_ To 1 Step -1 If ar_(i, 1) <> "" Then Exit For Else If ar_(i, 2) <> "" Then Exit For End If End If Next i Rows(r0_ + i).Resize(nr_ - i).EntireRow.Hidden = True Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub