Добрый день и с наступающим Вас Новым Годом! Я плохо разбираюсь в коде. Помогите пожалуйста подсказать и доработать.
Есть код скрытых строк по цветам для листа 1.
Проблема: При двойном щелчке на синюю ячейку, список раскрывается полностью, вместе с содержимим зеленых ячеек. Задача: При двойном щелчке на синюю ячейку, должен открываться список только с двумя зелеными ячейками, не расскрывая самих зеленых ячеек. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False
If Target.Column = 7 And Target.MergeCells And _ Target.Interior.Color = 13995347 Or _ Target.Interior.Color = 5287936 Or _ Target.Interior.Color = 5296274 Or _ Target.Interior.Color = 10213316 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden)
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Then Exit For Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell Cancel = True End If End Sub
[/vba] Так же хотелось бы для себя разобраться в логике кода. Правильно ли я понял? 1) Работать все это будет от двойного щелчка; 2) У нас отключено обновление экрана, чтобы все работало быстрее; 3) Цель условия 7 столбик и цель объедененная ячейка, так же цели: цвет синий или зеленый или салатовый или светло-салатовый; 4) А после цветов я понимаю всё очень смутно, тут у нас само выполение и проблема как раз-таки здесь, цикл и условие выхода из цикла. Объясните пожалуйста более подробно 4 пункт.
Добрый день и с наступающим Вас Новым Годом! Я плохо разбираюсь в коде. Помогите пожалуйста подсказать и доработать.
Есть код скрытых строк по цветам для листа 1.
Проблема: При двойном щелчке на синюю ячейку, список раскрывается полностью, вместе с содержимим зеленых ячеек. Задача: При двойном щелчке на синюю ячейку, должен открываться список только с двумя зелеными ячейками, не расскрывая самих зеленых ячеек. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False
If Target.Column = 7 And Target.MergeCells And _ Target.Interior.Color = 13995347 Or _ Target.Interior.Color = 5287936 Or _ Target.Interior.Color = 5296274 Or _ Target.Interior.Color = 10213316 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden)
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Then Exit For Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell Cancel = True End If End Sub
[/vba] Так же хотелось бы для себя разобраться в логике кода. Правильно ли я понял? 1) Работать все это будет от двойного щелчка; 2) У нас отключено обновление экрана, чтобы все работало быстрее; 3) Цель условия 7 столбик и цель объедененная ячейка, так же цели: цвет синий или зеленый или салатовый или светло-салатовый; 4) А после цветов я понимаю всё очень смутно, тут у нас само выполение и проблема как раз-таки здесь, цикл и условие выхода из цикла. Объясните пожалуйста более подробно 4 пункт.Neznaika22
Neznaika22, А что в той теме у автора не спросили? :-)
Я там к стати совсем убрал контроль по цвету из условия первичного и добавил исключение первой строки.
Принцип был прост , от ячейки что объединена, до аналогичной(или до конца) нужно скрыть или открыть строки. то есть если дошли до равенства myCell.Interior.Color = Target.Interior.Color , то более не требуется обрабатывать и выходим из цикла.
если нужно обеспечить вложенность групп, то надо менять алгоритм, так как весьма непросто пояснить где конец конкретной группы. хотя можно подумать, но без промежуточного хранения не обеспечить открытие нижнего уровня если он был открыт ранее при закрытии и повторном открытии верхнего.
Доработал, скрывает все, открывает последовательно по уровням.
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 And Target.MergeCells And Target.Row > 1 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden) With Application .ScreenUpdating = False .EnableEvents = False End With If Target.Offset(1).MergeCells Then SubGroupcolor = Target.Offset(1).Interior.Color Items = False Else Items = True End If
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Or (Items And myCell.MergeCells) Then Exit For
If (myCell.MergeCells And myCell.Interior.Color = SubGroupcolor) Or RowHidden Or Items Then Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell With Application .ScreenUpdating = True .EnableEvents = True End With Cancel = True End If
End Sub
[/vba]
Neznaika22, А что в той теме у автора не спросили? :-)
Я там к стати совсем убрал контроль по цвету из условия первичного и добавил исключение первой строки.
Принцип был прост , от ячейки что объединена, до аналогичной(или до конца) нужно скрыть или открыть строки. то есть если дошли до равенства myCell.Interior.Color = Target.Interior.Color , то более не требуется обрабатывать и выходим из цикла.
если нужно обеспечить вложенность групп, то надо менять алгоритм, так как весьма непросто пояснить где конец конкретной группы. хотя можно подумать, но без промежуточного хранения не обеспечить открытие нижнего уровня если он был открыт ранее при закрытии и повторном открытии верхнего.
Доработал, скрывает все, открывает последовательно по уровням.
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 And Target.MergeCells And Target.Row > 1 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden) With Application .ScreenUpdating = False .EnableEvents = False End With If Target.Offset(1).MergeCells Then SubGroupcolor = Target.Offset(1).Interior.Color Items = False Else Items = True End If
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Or (Items And myCell.MergeCells) Then Exit For
If (myCell.MergeCells And myCell.Interior.Color = SubGroupcolor) Or RowHidden Or Items Then Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell With Application .ScreenUpdating = True .EnableEvents = True End With Cancel = True End If
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 And Target.MergeCells And Target.Row > 1 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden) With Application .ScreenUpdating = False .EnableEvents = False End With If Target.Offset(1).MergeCells Then SubGroupcolor = Target.Offset(1).Interior.Color Items = False Else Items = True End If
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Then Exit For If (myCell.MergeCells And myCell.Interior.Color = SubGroupcolor) Or _ RowHidden Or Items _ Then Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell With Application .ScreenUpdating = True .EnableEvents = True End With Cancel = True End If
End Sub
[/vba]
Совершенно невозможно на работе кодить :-)
Mikael, спасибо и за респект и за замечание,
там это ваще ненужно
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 And Target.MergeCells And Target.Row > 1 Then RowHidden = Not (Rows(Target.Row + 1).EntireRow.Hidden) With Application .ScreenUpdating = False .EnableEvents = False End With If Target.Offset(1).MergeCells Then SubGroupcolor = Target.Offset(1).Interior.Color Items = False Else Items = True End If
For Each myCell In Intersect(Range(Target.Offset(1), Cells(Rows.Count, Target.Column)), Me.UsedRange) If myCell.Interior.Color = Target.Interior.Color Then Exit For If (myCell.MergeCells And myCell.Interior.Color = SubGroupcolor) Or _ RowHidden Or Items _ Then Rows(myCell.Row).EntireRow.Hidden = RowHidden Next myCell With Application .ScreenUpdating = True .EnableEvents = True End With Cancel = True End If
End Sub
[/vba]
Совершенно невозможно на работе кодить :-)bmv98rus
Прошу прощения, новогодние приготовления, совсем не было времени. Всем спасибо за разъяснение, bmv98rus отдельное спасибо за весь макрос! Pelena, впредь буду знать, как выставлять макрос на форум, через кнопку #. Сейчас уже не могу этого сделать, редактирование запрещено.
Вех с наступающим Новым Годом, всех благ, пусть 2018 год принесёт больше радости, чем 2017!
Прошу прощения, новогодние приготовления, совсем не было времени. Всем спасибо за разъяснение, bmv98rus отдельное спасибо за весь макрос! Pelena, впредь буду знать, как выставлять макрос на форум, через кнопку #. Сейчас уже не могу этого сделать, редактирование запрещено.
Вех с наступающим Новым Годом, всех благ, пусть 2018 год принесёт больше радости, чем 2017!Neznaika22