Оптимизировать код.

[Demetros]

Народ, доброе время суток. Сделал для себя макрос "как есть" , но мне кажется его еще можно немного допилить. Помогите оптимизировать код:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Target.Address(0, 0) = "B20" Then
            Лист1.Rows(21).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B21" Then
            Лист1.Rows(22).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B22" Then
            Лист1.Rows(23).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B23" Then
            Лист1.Rows(24).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B24" Then
            Лист1.Rows(25).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B25" Then
            Лист1.Rows(26).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If
        If Target.Address(0, 0) = "B26" Then
            Лист1.Rows(27).EntireRow.Hidden = IIf(Target.Value = "", True, False)
        End If

И так еще несколько десятков раз...

End Sub


Судя по внешнему виду сюда, как мне кажется, можно воткнуть цикл, но как это сделать моих познаний VBA не хватает.

[27102014]

Вы бы лучше файл добавили - исходные данные можно заменить на что угодно

[EducatedFool]

Private Sub Worksheet_Change(ByVal Target As Range)
    ' выход, если изменено больше одной ячейки
    If Target.Cells.Count > 1 Then Exit Sub

    ' при изменении одной из ячеек диапазона B20:B26
    If Not Intersect(Target, Me.Range("B20:B26")) Is Nothing Then
        Target.Offset(1).EntireRow.Hidden = Target.Value = ""
    End If
End Sub

[IgorGO]

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  For Each c In Target.Cells
    If Not Application.Intersect(c, Лист1.[b20:b9999]) Is Nothing Then
      c.EntireRow.Hidden = c = ""
    End If
  Next
End Sub

[Demetros]

Сообщение от EducatedFool

Private Sub Worksheet_Change(ByVal Target As Range)
    ' выход, если изменено больше одной ячейки
    If Target.Cells.Count > 1 Then Exit Sub

    ' при изменении одной из ячеек диапазона B20:B26
    If Not Intersect(Target, Me.Range("B20:B26")) Is Nothing Then
        Target.Offset(1).EntireRow.Hidden = Target.Value = ""
    End If
End Sub

Спасибо огромное! Работает, даже больше чем хотелось за что отдельное спасибо.

[Demetros]

Сообщение от IgorGO

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range
  For Each c In Target.Cells
    If Not Application.Intersect(c, Лист1.[b20:b9999]) Is Nothing Then
      c.EntireRow.Hidden = c = ""
    End If
  Next
End Sub

Спасибо за отклик. Тоже работает, но с обратным эффектом.

[IgorGO]

я провтыкал, что по состоянию В20 скрываем/показываем строку 21))
для "правильного эффекта" используйте так

c.Offset(1).EntireRow.Hidden = c = ""

предложенный вариант обработает ситуацию, когда в колонке В например копированием (или с помощью DELETE) было изменено сразу произвольное количество ячеек, а не обязательно по одной