Объединение не пересекаются, Target.Parent.Range и Worksheets.Cells - PullRequest
0 голосов
/ 20 мая 2019

Я намереваюсь добавить VBA, которая скрывает или показывает строки в зависимости от того, нажимает ли пользователь на конкретную ячейку, которая должна многократно повторяться.

Мне было интересно, как можно объединить Target.Parent.Range с Worksheet.Cells, чтобы я мог написать для него цикл, а не повторять код несколько раз. Приведенный ниже код работает нормально, но выглядит довольно неэффективно:

'Hide1
    If (ActiveSheet.Name = "Dashboard") And Not Intersect(Target, Target.Parent.Range("G38")) Is Nothing Then
        If Rows("40:47").EntireRow.Hidden = True Then
            Rows("40:47").EntireRow.Hidden = False
            Range("G38").Value = "Hide"
            ActiveSheet.Range("A1").Select
        Else
            Rows("40:47").EntireRow.Hidden = True
            Range("G38").Value = "Show"
            ActiveSheet.Range("A1").Select
        End If
    End If

'Hide2
    If (ActiveSheet.Name = "Dashboard") And Not Intersect(Target, Target.Parent.Range("G48")) Is Nothing Then
        If Rows("50:57").EntireRow.Hidden = True Then
            Rows("50:57").EntireRow.Hidden = False
            Range("G48").Value = "Hide"
            ActiveSheet.Range("A1").Select
        Else
            Rows("50:57").EntireRow.Hidden = True
            Range("G48").Value = "Show"
            ActiveSheet.Range("A1").Select
        End If
    End If

Это нужно будет повторять 10 раз, так как кнопки расположены с одинаковыми интервалами вниз по листу, поэтому цикличность наиболее целесообразна. Любая помощь будет очень полезна, поскольку мои попытки объединить две функции пока не увенчались успехом.

1 Ответ

0 голосов
/ 20 мая 2019

Ваш код может быть сокращен до этого

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim buttonRng As Range, hideRng As Range

    Application.EnableEvents = False

    Set buttonRng = Target

    ' Add in your ranges into this If statement
    If Not Intersect(Target, Me.Range("G38")) Is Nothing Then
        Set hideRng = Me.Rows("40:47")
    ElseIf Not Intersect(Target, Me.Range("G48")) Is Nothing Then
        Set hideRng = Me.Rows("50:57")
    Else
        Set hideRng = Nothing
    End If

    If Not hideRng Is Nothing Then
        With hideRng
            .Hidden = Not .Hidden
        End With

        buttonRng.Value2 = IIf(buttonRng.Value2 = "Show", "Hide", "Show")
    End If

    Application.EnableEvents = True
End Sub

Вы можете добавить дополнительный лист со списком адресов местоположений кнопок и диапазоном их скрытия.

enter image description here

Вам нужно будет установить столбец B в текст

и затем используйте следующий код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim buttonRng As Range, hideRng As Range

    Application.EnableEvents = False

    Set buttonRng = Target

    With Sheets("Button Hide Range").Columns(1)
        Set hideRng = .Find(Target.Address(False, False))
    End With

    If Not hideRng Is Nothing Then
        With Me.Rows(hideRng.Offset(0, 1).Value2)
            .Hidden = Not .Hidden
        End With

        buttonRng.Value2 = IIf(buttonRng.Value2 = "Show", "Hide", "Show")
    End If

    Application.EnableEvents = True
End Sub

Затем этот лист можно скрыть или установить для него значение xlVeryHidden, если оно не требуется для конечного пользователя.

Или, если все скрытые строки имеют одинаковое смещение от кнопок, которые вы можете использовать

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim buttonRng As Range
    Dim i As Long

    Application.EnableEvents = False
    ' i = row of first button to row of last button. Assuming each button is 10 rows apart from the previous
    For i = 38 To 78 Step 10
        If buttonRng Is Nothing Then
            Set buttonRng = Me.Range("G" & i)
        Else
            Set buttonRng = Union(buttonRng, Me.Range("G" & i))
        End If
    Next i

    If Not Intersect(Target, buttonRng) Is Nothing Then
        ' Assuming rows to be hidden are starts 2 rows away from button and ends 9 rows away
        With Me.Rows(Target.Offset(2).Row & ":" & Target.Offset(9).Row)
            .Hidden = Not .Hidden
        End With
        Target.Value2 = IIf(Target.Value = "Show", "Hide", "Show")
    End If

    Application.EnableEvents = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...