Просмотрев все подобные темы не удалось найти подходящего примера. Прошу помощи в написании макроса. Есть таблица, состоящая из нескольких разделов. Нужно скрыть строки в каждом из разделов (I, II), в которых по столбцам D и E нет данных. При этом основные пункты (закрашенные зеленой заливкой: А,Б,В,Г,Д и тд.), даже если в них сумма показателей равна нулю, скрываться не должны. Исходник прилагаю. Буду признательна за внимание и помощь.
Просмотрев все подобные темы не удалось найти подходящего примера. Прошу помощи в написании макроса. Есть таблица, состоящая из нескольких разделов. Нужно скрыть строки в каждом из разделов (I, II), в которых по столбцам D и E нет данных. При этом основные пункты (закрашенные зеленой заливкой: А,Б,В,Г,Д и тд.), даже если в них сумма показателей равна нулю, скрываться не должны. Исходник прилагаю. Буду признательна за внимание и помощь.Лорик
Sub hide_rows() Application.ScreenUpdating = False For Each cel In Range("B16", Cells(Rows.Count, 2).End(xlUp)) If cel.Interior.Color = 16777215 Then cel.EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
[/vba]
В оригинале тоже будет цветастенько? [vba]
Код
Sub hide_rows() Application.ScreenUpdating = False For Each cel In Range("B16", Cells(Rows.Count, 2).End(xlUp)) If cel.Interior.Color = 16777215 Then cel.EntireRow.Hidden = True End If Next Application.ScreenUpdating = True End Sub
Да, таблица будет как в исходнике. Но хотелось бы макрос не привязывать к цвету (заливке), так как хочу его применять и в других аналогичных условиях (файлах), а там и разделы могут быть другие и заливка. Вообщем, по возможности, макрос нужен универсальный. Сама макросы не умею создавать.Подгоняю готовые под свои условия чисто интуитивно (где удается понять). Но с таким условиям подходящего готового макроса найти не удалось.
Да, таблица будет как в исходнике. Но хотелось бы макрос не привязывать к цвету (заливке), так как хочу его применять и в других аналогичных условиях (файлах), а там и разделы могут быть другие и заливка. Вообщем, по возможности, макрос нужен универсальный. Сама макросы не умею создавать.Подгоняю готовые под свои условия чисто интуитивно (где удается понять). Но с таким условиям подходящего готового макроса найти не удалось.Лорик
Спасибо,wild_pig, что отозвались на мою просьбу. В Вашем коде все-таки привязка к цвету заливки (как я поняла?!). Попробовала его в своем файле, макрос скрывает все строки, в которых есть показатели (а это не нужно) и оставляет только те, что закрашены зеленым цветом. Скрывать нужно строки в которых нет данных, но те строки которые являются названиями пунктов в разделе (т.е являются сводной строкой по показателям которые в неё входят) скрываться не должны. Т.е при формировании таблицы на печать пользователь может видеть что, например, по пункту В раздела II показатели равны нулю. В файле проставила примерные показатели и отметила примерные строки, которые должны скрываться. Добавила макрос «Отобразить строки».Просматриваться на наличие показателей в ячейке должен столбец D и E. У меня есть макрос, но в нем просмотр идёт только по одному столбцу.
Спасибо,wild_pig, что отозвались на мою просьбу. В Вашем коде все-таки привязка к цвету заливки (как я поняла?!). Попробовала его в своем файле, макрос скрывает все строки, в которых есть показатели (а это не нужно) и оставляет только те, что закрашены зеленым цветом. Скрывать нужно строки в которых нет данных, но те строки которые являются названиями пунктов в разделе (т.е являются сводной строкой по показателям которые в неё входят) скрываться не должны. Т.е при формировании таблицы на печать пользователь может видеть что, например, по пункту В раздела II показатели равны нулю. В файле проставила примерные показатели и отметила примерные строки, которые должны скрываться. Добавила макрос «Отобразить строки».Просматриваться на наличие показателей в ячейке должен столбец D и E. У меня есть макрос, но в нем просмотр идёт только по одному столбцу.Лорик
Нет, конечно. Но в строке (в Вашем коде) (For Each cel In Range("A16", Cells(Rows.Count, 2).End(xlUp)), Range("A16.. указывает на номер строки с которой происходит скрытие строк, думаю для другой таблицы нужно её изменить на соответствующий?!... P.S Простите не знаю как вставить текст кода макроса.
Нет, конечно. Но в строке (в Вашем коде) (For Each cel In Range("A16", Cells(Rows.Count, 2).End(xlUp)), Range("A16.. указывает на номер строки с которой происходит скрытие строк, думаю для другой таблицы нужно её изменить на соответствующий?!... P.S Простите не знаю как вставить текст кода макроса.Лорик
Дайте имя MYCOLOR ячейке F15. Из этой ячейки будет браться образец цвета для не скрываемых строк и от неё вниз будет обрабатываться таблица. В модуле листа пропишите процедуру:[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = Me.[MYCOLOR].Interior.Color Application.ScreenUpdating = False For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next Application.ScreenUpdating = True End Sub
[/vba]
Дайте имя MYCOLOR ячейке F15. Из этой ячейки будет браться образец цвета для не скрываемых строк и от неё вниз будет обрабатываться таблица. В модуле листа пропишите процедуру:[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = Me.[MYCOLOR].Interior.Color Application.ScreenUpdating = False For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next Application.ScreenUpdating = True End Sub
Лорик, я с работы не могу скачивать файлы с макросами (спасибо собакам-сисадминам, боящимся макровирусов, давно вымерших как динозавры). Из Ваших скриншотов не видно, какой модуль проекта активен. Но что-то мне подсказывает, что макрос Вы расположили в стандартном модуле, а не в модуле листа. А ведь я указал:
Именно поэтому обращение "Ме" вызывает ошибку. Для модуля листа объектом, к которому сокращенно обращаются как Ме, является лист. Т.е. Ме для кода, размещённого в этом модуле, заменяет ThisWorkSheet, на котором, действительно, есть ячейки и диапазоны. А для стандартного модуля объектом является книга и поэтому сокращение Ме заменяет ThisWorkBook, где нет диапазонов и ячеек.
Лорик, я с работы не могу скачивать файлы с макросами (спасибо собакам-сисадминам, боящимся макровирусов, давно вымерших как динозавры). Из Ваших скриншотов не видно, какой модуль проекта активен. Но что-то мне подсказывает, что макрос Вы расположили в стандартном модуле, а не в модуле листа. А ведь я указал:
Именно поэтому обращение "Ме" вызывает ошибку. Для модуля листа объектом, к которому сокращенно обращаются как Ме, является лист. Т.е. Ме для кода, размещённого в этом модуле, заменяет ThisWorkSheet, на котором, действительно, есть ячейки и диапазоны. А для стандартного модуля объектом является книга и поэтому сокращение Ме заменяет ThisWorkBook, где нет диапазонов и ячеек.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 29.09.2014, 11:37
А если всё-таки размещать код в стандартном модуле, то обращаться к диапазону нужно с указанием того, на каком листе он расположен.
Чтобы не связываться с названием листа, которое в разных файлах может быть разным, удобнее обращаться к листам не по имени, отображаемом на ярлыке листа ("Расчет") , а по кодовому имени листа (Лист1). Кодовое имя видно в эксплорере проекта. Оно написано перед именем листа, помещённым в скобки. Для Вашего случая там написано Лист1 (Расчет) Поэтому в коде, размещаемом в стандартном модуле надо вместо Ме.[MYCOLOR] надо писать Лист1.[MYCOLOR]. или Sheets("Расчет").Range("MYCOLOR") Хотя если область определения имени - вся книга (по умолчанию для не повторяющихся в книге имён), то можно указание листа и опустить и обращаться без указания листа, опустив Ме. Например, [MYCOLOR].Interior.Color или Range("MYCOLOR").Interior.Color [vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
[/vba]
А если всё-таки размещать код в стандартном модуле, то обращаться к диапазону нужно с указанием того, на каком листе он расположен.
Чтобы не связываться с названием листа, которое в разных файлах может быть разным, удобнее обращаться к листам не по имени, отображаемом на ярлыке листа ("Расчет") , а по кодовому имени листа (Лист1). Кодовое имя видно в эксплорере проекта. Оно написано перед именем листа, помещённым в скобки. Для Вашего случая там написано Лист1 (Расчет) Поэтому в коде, размещаемом в стандартном модуле надо вместо Ме.[MYCOLOR] надо писать Лист1.[MYCOLOR]. или Sheets("Расчет").Range("MYCOLOR") Хотя если область определения имени - вся книга (по умолчанию для не повторяющихся в книге имён), то можно указание листа и опустить и обращаться без указания листа, опустив Ме. Например, [MYCOLOR].Interior.Color или Range("MYCOLOR").Interior.Color [vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
Да,Alex_ST, Вы оказались правы. Перенесла код в модуль листа. Все заработало, но не так как нужно. Привязка к заливке ячеек не совсем удобна, в Вашем варианте скрылись названия разделов (Объем и Расходы), а они нужны. Скрывать строки нужно именно между разделами, чтобы сохранился вид документа. Может проверку условия можно задать через диапазон. У меня есть макрос (может даже с этого форума), в нем задаются строки для проверки и если удовлетворяют условию, то скрываются. Я сделала этот макрос к каждому просматриваемому разделу, и задала их исполнение одним макросом. Но проблема в том, что проверка осуществляется только по одному столбцу, а мне нужно учитывать и второй столбец.
[vba]
Код
Sub Макрос1в() For i = 24 To 31 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос2в() For i = 36 To 66 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос3в() For i = 68 To 71 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос4в() For i = 73 To 82 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос5в() For i = 86 To 91 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос6в() For i = 93 To 97 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub СтартВ() Макрос1в Макрос2в Макрос3в Макрос4в Макрос5в Макрос6в End Sub
[/vba]
Да,Alex_ST, Вы оказались правы. Перенесла код в модуль листа. Все заработало, но не так как нужно. Привязка к заливке ячеек не совсем удобна, в Вашем варианте скрылись названия разделов (Объем и Расходы), а они нужны. Скрывать строки нужно именно между разделами, чтобы сохранился вид документа. Может проверку условия можно задать через диапазон. У меня есть макрос (может даже с этого форума), в нем задаются строки для проверки и если удовлетворяют условию, то скрываются. Я сделала этот макрос к каждому просматриваемому разделу, и задала их исполнение одним макросом. Но проблема в том, что проверка осуществляется только по одному столбцу, а мне нужно учитывать и второй столбец.
[vba]
Код
Sub Макрос1в() For i = 24 To 31 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос2в() For i = 36 To 66 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос3в() For i = 68 To 71 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос4в() For i = 73 To 82 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос5в() For i = 86 To 91 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub Макрос6в() For i = 93 To 97 'здесь ты задаёшь то количество строк которое тебе нужно у меня 50 однёрку не трогай это означает, что отбор будет с первой строки If Cells(i, 4) = 0 Then Rows(i).Select 'а вот тут однёрка означает номер столбца в данном случае A если D будет цифра 4 и т.д. настрой Excel не на буквы а на цифры чтобы лучше ориентироваться Selection.EntireRow.Hidden = True Next i End Sub Sub СтартВ() Макрос1в Макрос2в Макрос3в Макрос4в Макрос5в Макрос6в End Sub
Некогда разбироаться в чужих кодах. Давайте договоримся, что ячейки-заголовки отличаются от тех, которые нужно прятать тем, что они объединённые. Тогда всё просто (на этот раз код можно разместить и а коде листа, и в стандартном):[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor And Not rCell.MergeCells Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
[/vba]
Некогда разбироаться в чужих кодах. Давайте договоримся, что ячейки-заголовки отличаются от тех, которые нужно прятать тем, что они объединённые. Тогда всё просто (на этот раз код можно разместить и а коде листа, и в стандартном):[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor And Not rCell.MergeCells Then rCell.EntireRow.Hidden = Not (Cells(rCell.Row, 4) + Cells(rCell.Row, 5)) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
Alex_ST, понимаете, скрываются строки в которые мы вносим значения, а их скрывать не надо. Разделы состоят из пунктов, т.е. из строк (закрашенных у меня зеленной заливкой), в которой суммируются показатели занесенные в ПОДПУНКТЫ этих строк. И строки с показателями в подпунктах, должны скрываться только если в них нет данных (числа, текста). Разделы состоят из основных пунктов 1,2,3 и т.д. Но эти пункты, в свою очередь, состоят из подпунктов 1.1, 1.2, 1.3 и т.д. Они (подпункты) не должны скрываться, если в них есть данные. В таблице есть еще третий раздел, у него нет объединения ячеек, и он скрылся. А не должен. Привязка к заливке все таки не удобна.
Alex_ST, понимаете, скрываются строки в которые мы вносим значения, а их скрывать не надо. Разделы состоят из пунктов, т.е. из строк (закрашенных у меня зеленной заливкой), в которой суммируются показатели занесенные в ПОДПУНКТЫ этих строк. И строки с показателями в подпунктах, должны скрываться только если в них нет данных (числа, текста). Разделы состоят из основных пунктов 1,2,3 и т.д. Но эти пункты, в свою очередь, состоят из подпунктов 1.1, 1.2, 1.3 и т.д. Они (подпункты) не должны скрываться, если в них есть данные. В таблице есть еще третий раздел, у него нет объединения ячеек, и он скрылся. А не должен. Привязка к заливке все таки не удобна.Лорик
Понимаю, да особой спешки нет. На самом деле макрос который я выложила, мне подходит. Задаю проверку диапазона строк между основными пунктами, с условием, что если значение в ячейке равно нулю, то строка скрывается. В данном случае строки, закрашенные зеленой заливкой в проверку не включены и остаются открытыми. Одна ПРОБЛЕМА, как добавить условия проверки по ВТОРОМУ столбцу?!
[vba]
Код
Sub Макрос1в() For i = 24 To 31 'задаешь номера строк для проверки условия If Cells(i, 4) = 0 Then Rows(i).Select 'задаешь номер столбца для проверки условия Selection.EntireRow.Hidden = True Next i End Sub
Понимаю, да особой спешки нет. На самом деле макрос который я выложила, мне подходит. Задаю проверку диапазона строк между основными пунктами, с условием, что если значение в ячейке равно нулю, то строка скрывается. В данном случае строки, закрашенные зеленой заливкой в проверку не включены и остаются открытыми. Одна ПРОБЛЕМА, как добавить условия проверки по ВТОРОМУ столбцу?!
[vba]
Код
Sub Макрос1в() For i = 24 To 31 'задаешь номера строк для проверки условия If Cells(i, 4) = 0 Then Rows(i).Select 'задаешь номер столбца для проверки условия Selection.EntireRow.Hidden = True Next i End Sub
Лорик, для того, чтобы не скрывались строки-заголовки разделов, я предложил Вам договориться и ячейки с заголовками разделов сделать объединёнными (такими же, как у Вас в файле ячейки В16 - Объём и В34 - Расходы). Хотя про третий (четвёртый, шестой, стодвадцатьпятый) разделы в примере ничего не говорилось, но процедуре их количество по барабану. Главное чтобы соблюдалась договорённость о том, что строки-заголовки разделов содержат объединённые ячейки. Поймите, чтобы как-то разбираться в структуре Вашей таблицы процедуре надо указать конкретный признак строки с заголовком. Самый простой и очевидный из Вашего примера признак - объединённая ячейка. Но вполне можно и что-то другое использовать. Главное чтобы этот признак встречался только в заголовках. Если не хотите делать объединённые ячейки в заголовках, то флаг Вам в руки. Придумывайте другой признак и пишите коды.
А по поводу лишних скрывающихся строк, то это на самом деле мой косяк в коде процедуры, да ещё плюс к тому - нестандартная реакция VBA на вообще-то стандартные переводы числовых значений в логические, используемые для сокращения кода (также как использование [MYCOLOR] вместо Range("MYCOLOR") ). Обычно всегда Excel понимает числа >0 как Истина, а =0 как Ложь. И поэтому сумма пустых или нулевых ячеек должна была быть обработана как ЛОЖЬ , а ненулевых как ИСТИНА Ну ладно, исправил. Написал "как в учебнике". Проверил. Теперь работает.[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor And Not rCell.MergeCells Then rCell.EntireRow.Hidden = Not (CBool(Cells(rCell.Row, 4) + Cells(rCell.Row, 5))) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
[/vba]
Лорик, для того, чтобы не скрывались строки-заголовки разделов, я предложил Вам договориться и ячейки с заголовками разделов сделать объединёнными (такими же, как у Вас в файле ячейки В16 - Объём и В34 - Расходы). Хотя про третий (четвёртый, шестой, стодвадцатьпятый) разделы в примере ничего не говорилось, но процедуре их количество по барабану. Главное чтобы соблюдалась договорённость о том, что строки-заголовки разделов содержат объединённые ячейки. Поймите, чтобы как-то разбираться в структуре Вашей таблицы процедуре надо указать конкретный признак строки с заголовком. Самый простой и очевидный из Вашего примера признак - объединённая ячейка. Но вполне можно и что-то другое использовать. Главное чтобы этот признак встречался только в заголовках. Если не хотите делать объединённые ячейки в заголовках, то флаг Вам в руки. Придумывайте другой признак и пишите коды.
А по поводу лишних скрывающихся строк, то это на самом деле мой косяк в коде процедуры, да ещё плюс к тому - нестандартная реакция VBA на вообще-то стандартные переводы числовых значений в логические, используемые для сокращения кода (также как использование [MYCOLOR] вместо Range("MYCOLOR") ). Обычно всегда Excel понимает числа >0 как Истина, а =0 как Ложь. И поэтому сумма пустых или нулевых ячеек должна была быть обработана как ЛОЖЬ , а ненулевых как ИСТИНА Ну ладно, исправил. Написал "как в учебнике". Проверил. Теперь работает.[vba]
Код
Sub Hide_Empty_Rows() Dim rCell As Range, lColor& lColor = [MYCOLOR].Interior.Color With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With For Each rCell In Range("B" & [MYCOLOR].Offset(1).Row, Cells(Rows.Count, 2).End(xlUp)) If rCell.Interior.Color <> lColor And Not rCell.MergeCells Then rCell.EntireRow.Hidden = Not (CBool(Cells(rCell.Row, 4) + Cells(rCell.Row, 5))) End If Next With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
Но хотелось бы макрос не привязывать к цвету (заливке), так как хочу его применять и в других аналогичных условиях (файлах), а там и разделы могут быть другие и заливка. Вообщем, по возможности, макрос нужен универсальный.
Т.е. "цветовая дифференциация штанов" и универсальность Вам уже не нужны? И судя по Вашему макросу не нужно даже автоматическое определение границ обрабатываемого диапазона, а вполне можно и "ручками" (т.е. выделением на листе) обойтись? А по поводу Вашего вопроса о том как проверять значения в двух ячейках одновременно, то в моём предыдущем посте всё сделано. Ваш макрос после сокращения избыточности будет выглядеть так:[vba]
Код
Sub Макрос1в() Dim i For i = 24 To 31 Rows(i).EntireRow.Hidden = Not (CBool(Cells(i, 4) + Cells(i, 5))) Next i End Sub
Но хотелось бы макрос не привязывать к цвету (заливке), так как хочу его применять и в других аналогичных условиях (файлах), а там и разделы могут быть другие и заливка. Вообщем, по возможности, макрос нужен универсальный.
Т.е. "цветовая дифференциация штанов" и универсальность Вам уже не нужны? И судя по Вашему макросу не нужно даже автоматическое определение границ обрабатываемого диапазона, а вполне можно и "ручками" (т.е. выделением на листе) обойтись? А по поводу Вашего вопроса о том как проверять значения в двух ячейках одновременно, то в моём предыдущем посте всё сделано. Ваш макрос после сокращения избыточности будет выглядеть так:[vba]
Код
Sub Макрос1в() Dim i For i = 24 To 31 Rows(i).EntireRow.Hidden = Not (CBool(Cells(i, 4) + Cells(i, 5))) Next i End Sub