Кросс: http://www.excel-vba.ru/forum/index.php?topic=4016.msg21739#msg21739 Есть книга с примерно 30 листами, каждый лист нужно печатать все не заполнение строки в нем скриваютса для удобной печать и экономии бумаги=) Но попадаютса не всегда но есть листы в которых совсем нет даных но их тоже нужно печатать так вот нужно сделать так чтоб: Во 1-х оставить строчку итого! (она для каждого листа разная) Во 2-х оставить отобранной диапазон допустим с 5 по 16 строчки! И в 3-х Скрыть область с 17 по строчку х (где х- строчка перед строчкой итого=) Зарание благодарен!
Вот попробовал сам написать примерный макрос по моему требованию но тут походу много ошыбок =) В начале темы изменил суть своего вопроса думаю теперь боле понятно=)
Код
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
Sub jjj()
Application.FindFormat.Clear
For Each wsh In ThisWorkbook.Worksheets
Set trgt_rng = wsh.Rows("17:" & 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(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
Next wsh
End Sub
Изменено: JayBhagavan - 14.08.2015 16:00:04(скорректировал слегка макрос)
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
Никак не пойму что делает этот цыкал! Если можно вкратце объясните=) Зарание благодарен! П.С. Кстате макрос работает спс! Теперь будем над ним работать=)
Код
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
Написано же - отображает строку cl - строка, в ней проверяются ячейки 15, 57-59, длина строки в ячейке 4. Все проверки объединены условиями ИЛИ. Если хотя бы одно условие выполняется, то строку показать.
Доброго времени суток. Помогите пожалуйста поправить данный код для выполнения задачи в рамках ОДНОГО определенного листа...
Код
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
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
'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
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