Добрый вечер. Прошу помощи. В файле в модуле 2 есть макрос. Он косячный это точно. Либо его нужно поправить либо прошу предложить новое решение. В файле 3515 строк ( 3515 итоговая и файл будет содержать столько строк !) По мере заполнения поле может остаться пустым ( н-р строк 3514, заполнено 3496 ,остальное пусто ) Вот пустое поле надо скрыть , а при необходимости раскрыть. Итоговая строка должна отображаться!!! Приоритетом является столбец E (он главный)
Добрый вечер. Прошу помощи. В файле в модуле 2 есть макрос. Он косячный это точно. Либо его нужно поправить либо прошу предложить новое решение. В файле 3515 строк ( 3515 итоговая и файл будет содержать столько строк !) По мере заполнения поле может остаться пустым ( н-р строк 3514, заполнено 3496 ,остальное пусто ) Вот пустое поле надо скрыть , а при необходимости раскрыть. Итоговая строка должна отображаться!!! Приоритетом является столбец E (он главный)GGR
_Boroda_, все отлично работает. Я забыла вложить в файл лист " Стат" .На этом листе к сожалению макрос не работает . Можно сделать , чтобы макрос работал на 2 листа сразу? Приоритетом в листе " стат" столбец А. Подскажите пожалуйста, это для понимания как читается ваш макрос. Что такое r0_ = 3?
_Boroda_, все отлично работает. Я забыла вложить в файл лист " Стат" .На этом листе к сожалению макрос не работает . Можно сделать , чтобы макрос работал на 2 листа сразу? Приоритетом в листе " стат" столбец А. Подскажите пожалуйста, это для понимания как читается ваш макрос. Что такое r0_ = 3?GGR
Sub Skr() r0_ = 3 'номер строки, с которой начинаем проверять 'ищем слово "ИТОГО" - это будет тот столбец, по которому проверяем c0_ = Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True).Column nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ 'кол-во строк, которые проверяем 'с ячейки строки r0_ столбца c0_ вниз на nr_ ищем все пустые и скрываем их Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ' End Sub
Sub Otkr() r0_ = 3 c0_ = Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True).Column nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False End Sub
[/vba]
Так? [vba]
Код
Sub Skr() r0_ = 3 'номер строки, с которой начинаем проверять 'ищем слово "ИТОГО" - это будет тот столбец, по которому проверяем c0_ = Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True).Column nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ 'кол-во строк, которые проверяем 'с ячейки строки r0_ столбца c0_ вниз на nr_ ищем все пустые и скрываем их Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ' End Sub
Sub Otkr() r0_ = 3 c0_ = Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True).Column nr_ = Cells(Rows.Count, c0_).End(3).Row - r0_ Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False End Sub
_Boroda_, добрый день.Очень извиняюсь, когда проверила макрос на вспомогательном файле все сработало.Но в связи с тем , что были изменения в " база" и на листе " стат" сейчас в пустых ячейках 0 (н-р А187) , то макрос на скрыть / раскрыть не работает ( лист " Стат"). Посмотрите пожалуйста что можно поменять , чтобы он был универсальным для 2 листов
_Boroda_, добрый день.Очень извиняюсь, когда проверила макрос на вспомогательном файле все сработало.Но в связи с тем , что были изменения в " база" и на листе " стат" сейчас в пустых ячейках 0 (н-р А187) , то макрос на скрыть / раскрыть не работает ( лист " Стат"). Посмотрите пожалуйста что можно поменять , чтобы он был универсальным для 2 листовGGR
Sub Skr() r0_ = 3 With Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True) c0_ = .Column r1_ = .Row End With nr_ = r1_ - r0_ On Error Resume Next Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ' If Err Then ar_ = Cells(r0_, c0_).Resize(nr_) For i = nr_ To 1 Step -1 If ar_(i, 1) <> 0 And ar_(i, 1) <> "" Then nrSkr_ = nr_ - i Exit For End If Next i If nrSkr_ Then Cells(r0_ + nr_ - nrSkr_, c0_).Resize(nrSkr_).EntireRow.Hidden = True End If End If On Error GoTo 0 End Sub
Sub Otkr() r0_ = 3 With Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True) c0_ = .Column r1_ = .Row End With nr_ = r1_ - r0_ Application.ScreenUpdating = 0 Application.Calculation = 3 Cells(r0_, c0_).Resize(nr_).EntireRow.Hidden = False Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub
[/vba]
Попробуйте так [vba]
Код
Sub Skr() r0_ = 3 With Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True) c0_ = .Column r1_ = .Row End With nr_ = r1_ - r0_ On Error Resume Next Cells(r0_, c0_).Resize(nr_).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ' If Err Then ar_ = Cells(r0_, c0_).Resize(nr_) For i = nr_ To 1 Step -1 If ar_(i, 1) <> 0 And ar_(i, 1) <> "" Then nrSkr_ = nr_ - i Exit For End If Next i If nrSkr_ Then Cells(r0_ + nr_ - nrSkr_, c0_).Resize(nrSkr_).EntireRow.Hidden = True End If End If On Error GoTo 0 End Sub
Sub Otkr() r0_ = 3 With Cells.Find(What:="ИТОГО", LookAt:=xlWhole, MatchCase:=True) c0_ = .Column r1_ = .Row End With nr_ = r1_ - r0_ Application.ScreenUpdating = 0 Application.Calculation = 3 Cells(r0_, c0_).Resize(nr_).EntireRow.Hidden = False Application.Calculation = 1 Application.ScreenUpdating = 1 End Sub