Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос скрытия диапазона с условием
 
#1
13.08.2015 15:04:14
Кросс: http://www.excel-vba.ru/forum/index.php?topic=4016.msg21739#msg21739
Есть книга с примерно 30 листами, каждый лист нужно печатать все не заполнение строки в нем скриваютса для удобной печать и экономии бумаги=)
Но попадаютса не всегда но есть листы в которых совсем нет даных но их тоже нужно печатать так вот нужно сделать так чтоб:
Во 1-х оставить строчку итого! (она для каждого листа разная) Во 2-х оставить отобранной диапазон допустим  с 5 по 16 строчки!
И в 3-х Скрыть область с 17 по строчку х (где х- строчка перед строчкой итого=)
Зарание благодарен!
Изменено: GermeS - 14.08.2015 12:39:57
 
 
 
#2
14.08.2015 10:03:32
GermeS, здравия. Оформите более лаконично сумбур Ваших мыслей. Не понял что Вы хотите от макроса.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
14.08.2015 12:34:59
Вот попробовал сам написать примерный макрос по моему требованию но тут походу много ошыбок =)
В начале темы изменил суть своего вопроса думаю теперь боле понятно=)
Код
Sub макрос()
    Dim cell As Range
    Dim lRowNomber As Long
    Dim i As Long
    Dim Rng As Range
    Application.ScreenUpdating = False
    If Rows("5:153").Hidden = True Then
    Rows.Hidden = False
    End If
    For Each cell In ActiveSheet.UsedRange.Columns(3).Cells
        If cell.Value = "Èòîãî" Then
        cell.Activate
        lRowNumber = ActiveCellRow
        i = lRowNumber
        End If
    Next
    On Error Resume Next
    Set Rng = Range(Cells(5, 4), Cells(i - 1, 4)).EntireRow
    On Error GoTo 0
    Rng.Hidden = True
    If Rows(1).Hidden = False Then Rows(1).Hidden = True
    If Columns(1).Hidden = False Then Columns(1).Hidden = True
    Application.ScreenUpdating = True
End Sub
Изменено: GermeS - 14.08.2015 12:41:29
 
 
 
#4
14.08.2015 14:18:05
малова-то вводных по условиям, малова-то...
Изменено: JayBhagavan - 14.08.2015 16:00:04 (скорректировал слегка макрос)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#5
17.08.2015 10:39:21
Спасибо JayBhagavan буду побывать, о результате отпишусь=)  
 
 
 
#6
18.08.2015 11:19:55
Никак не пойму что делает этот цыкал! Если можно вкратце объясните=) Зарание благодарен!
П.С. Кстате макрос работает спс! Теперь будем над ним работать=)
Код
 For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(15).Value <> 0 Or _
                cl.Cells(57).Value <> 0 Or _
                cl.Cells(58).Value <> 0 Or _
                cl.Cells(59).Value <> 0 _
                Then cl.Hidden = False ' отображаем строку
        Next cl
Изменено: GermeS - 18.08.2015 11:20:47
 
 
 
#7
18.08.2015 11:23:14
Написано же - отображает строку :)
cl - строка, в ней проверяются ячейки 15, 57-59, длина строки в ячейке 4. Все проверки объединены условиями ИЛИ.
Если хотя бы одно условие выполняется, то строку показать.
 
 
 
#8
18.08.2015 11:37:36
ясн спс=) Сглупил=)
 
 
 
#9
18.02.2020 20:15:57
Доброго времени суток. Помогите пожалуйста поправить данный код для выполнения задачи в рамках ОДНОГО определенного листа...
Код
Sub jjj()
     Application.FindFormat.Clear
     For Each sh In Sheets(Array("Äåôåêòíàÿ_âåäîìîñòü", "Àêò_ñïèñàíèÿ_ìàòåðèàëîâ", "Ëèìèòíî-çàáîðíàÿ_êàðòà"))
        Set trgt_rng = wsh.Rows("14:" & wsh.Cells.SpecialCells(xlLastCell).Row) _
            ' çàäà¸ì öåëåâîé äèàïàçîí
        trgt_rng.Hidden = True ' ñêðûâàåì öåëåâûå ñòðîêè
        Set clf = trgt_rng.Find(What:="ÈÒÎÃÎ", After:=trgt_rng.Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False) ' ïîèñê "ÈÒÎÃÎ" íà ëèñòå
        If Not clf Is Nothing Then ' åñëè ðåç. ïîèñêà íå ïóñòîé
            firstAddress = clf.Address ' çàïîìèíàåì àäðåñ. ïåðâ. íàéä. ÿ÷.
            Do
                clf.EntireRow.Hidden = False ' îòîáðàæàåì ñòðîêó ñ "èòîãî"
                Set clf = trgt_rng.FindNext(clf) ' ïðîäîëæàåì ïîèñê
            Loop While Not clf Is Nothing And clf.Address <> firstAddress ' _
                öèêë ïîêà ëèáî íè÷åãî íå íàøëè, ëèáî ïîêà íå âåðíóëèñü â ïîçèöèþ ïåðâ. íàéä. ÿ÷.
        End If
        For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(6).Value <> 0 Or _
                cl.Cells(7).Value <> 0 Or _
                cl.Cells(8).Value <> 0 Or _
                cl.Cells(13).Value <> 0 _
                Then cl.Hidden = False ' îòîáðàæàåì ñòðîêó
        Next cl
    Next sh
End Sub
Изменено: sotmel - 18.02.2020 20:16:43
 
 
 
#10
19.02.2020 09:15:32
Код
For Each sh In Sheets(Array("Äåôåêòíàÿ_âåäîìîñòü"))    
 
 
 
#11
19.02.2020 10:06:26
МатросНаЗебре, так пробовал, тоже ругается...
Код
Application.FindFormat.Clear
     For Each sh In SheetsArray("Дефектная_ведомость")
        Set trgt_rng = wsh.Rows("14:" & wsh.Cells.SpecialCells(xlLastCell).Row) _
            ' задаём целевой диапазон
        trgt_rng.Hidden = True ' скрываем целевые строки
        Set clf = trgt_rng.Find(What:="ИТОГО", After:=trgt_rng.Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False) ' поиск "ИТОГО" на листе
        If Not clf Is Nothing Then ' если рез. поиска не пустой
            firstAddress = clf.Address ' запоминаем адрес. перв. найд. яч.
            Do
                clf.EntireRow.Hidden = False ' отображаем строку с "итого"
                Set clf = trgt_rng.FindNext(clf) ' продолжаем поиск
            Loop While Not clf Is Nothing And clf.Address <> firstAddress ' _
                цикл пока либо ничего не нашли, либо пока не вернулись в позицию перв. найд. яч.
        End If
        For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(6).Value <> 0 Or _
                cl.Cells(7).Value <> 0 Or _
                cl.Cells(8).Value <> 0 Or _
                cl.Cells(13).Value <> 0 _
                Then cl.Hidden = False ' отображаем строку
        Next cl
    Next sh
End Sub
Изменено: sotmel - 19.02.2020 10:06:55
 
 
 
#12
19.02.2020 10:09:57
Код
'For Each sh In SheetsArray("Дефектная_ведомость")        
Set sh = Sheets("Дефектная_ведомость")        
Set trgt_rng = wsh.Rows("14:" & wsh.Cells.SpecialCells(xlLastCell).Row) _
            ' задаём целевой диапазон
        trgt_rng.Hidden = True ' скрываем целевые строки
        Set clf = trgt_rng.Find(What:="ИТОГО", After:=trgt_rng.Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False) ' поиск "ИТОГО" на листе
        If Not clf Is Nothing Then ' если рез. поиска не пустой
            firstAddress = clf.Address ' запоминаем адрес. перв. найд. яч.
            Do
                clf.EntireRow.Hidden = False ' отображаем строку с "итого"
                Set clf = trgt_rng.FindNext(clf) ' продолжаем поиск
            Loop While Not clf Is Nothing And clf.Address <> firstAddress ' _
                цикл пока либо ничего не нашли, либо пока не вернулись в позицию перв. найд. яч.
        End If
        For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(6).Value <> 0 Or _
                cl.Cells(7).Value <> 0 Or _
                cl.Cells(8).Value <> 0 Or _
                cl.Cells(13).Value <> 0 _
                Then cl.Hidden = False ' отображаем строку
        Next cl
    'Next sh
 
 
 
#13
19.02.2020 10:12:01
Код
Set trgt_rng = sh.Rows
Видимо, и тут надо поправить.
 
 
 
#14
19.02.2020 11:17:06
так заработало
Код
Sub jjj()
     Application.FindFormat.Clear
     'For Each sh In SheetsArray("Дефектная_ведомость")
Set sh = Sheets("Дефектная_ведомость")
Set trgt_rng = sh.Rows("14:" & sh.Cells.SpecialCells(xlLastCell).Row) _
            ' задаём целевой диапазон
        trgt_rng.Hidden = True ' скрываем целевые строки
        Set clf = trgt_rng.Find(What:="ИТОГО", After:=trgt_rng.Cells(1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
            SearchFormat:=False) ' поиск "ИТОГО" на листе
        If Not clf Is Nothing Then ' если рез. поиска не пустой
            firstAddress = clf.Address ' запоминаем адрес. перв. найд. яч.
            Do
                clf.EntireRow.Hidden = False ' отображаем строку с "итого"
                Set clf = trgt_rng.FindNext(clf) ' продолжаем поиск
            Loop While Not clf Is Nothing And clf.Address <> firstAddress ' _
                цикл пока либо ничего не нашли, либо пока не вернулись в позицию перв. найд. яч.
        End If
        For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(6).Value <> 0 Or _
                cl.Cells(7).Value <> 0 Or _
                cl.Cells(8).Value <> 0 Or _
                cl.Cells(13).Value <> 0 _
                Then cl.Hidden = False ' отображаем строку
        Next cl
    'Next sh
End Sub
 
 
 
Страницы: 1
Наверх