Как автоматически скрывать и отображать строки в Excel на основе значения нескольких ячеек - PullRequest
0 голосов
/ 22 сентября 2018

введите описание изображения здесь Я новичок в совершенствовании макроса.Я пытаюсь создать макрос, чтобы автоматически скрывать и отображать строки в Excel на основе значения нескольких ячеек.Я создал две раскрывающиеся ячейки со значением, используя проверку данных и основываясь на раскрывающемся списке, который я пытаюсь скрыть и показать.Если первое раскрывающееся меню - «Класс I», а второе раскрывающееся значение - Ä, то должна быть видна только строка от 8 до 20, а строка от 21 до конца строк должна быть скрыта, и аналогично, когда первый раскрывающийся список - «Класс I»и второе раскрывающееся значение - «B», строка от 8 до конца строк должна быть скрыта, за исключением строк с 23 по 31. Если требуется, я могу предоставить файл excel, он содержит фиктивные данные

1 Ответ

0 голосов
/ 22 сентября 2018

Поместите этот код в личную таблицу кодов рабочего листа, доступную через правую кнопку мыши на вкладке имени рабочего листа, Просмотреть код.Измените диапазоны строк, чтобы они соответствовали.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("D3, D4")) Is Nothing Then
        On Error GoTo meh
        Application.ScreenUpdating = False
        Range("8:" & Me.UsedRange.Rows.Count).EntireRow.Hidden = True
        Select Case Range("D3").Value2
            Case "Class I"
                Select Case Range("D4").Value2
                    Case ChrW(196)  'Ä
                        Intersect(Range("8:20"), Me.UsedRange).EntireRow.Hidden = False
                    Case "B"
                        Intersect(Range("21:33"), Me.UsedRange).EntireRow.Hidden = False
                    Case Else
                        'do nothing
                End Select
            Case "Class II"
                'copy above for Class I here
                'modify rows to show/hide
            Case Else
                'do nothing
        End Select
    End If

meh:
    Application.ScreenUpdating = True

End Sub
...