根据下拉列表隐藏单元格，未选中时保持激活

Question

我创建了我的 VBA 对象来隐藏和激活单元格，具体取决于是否选择了特定值。这都包含在第一列中。

但是，每当我在输入信息后继续编辑任何其他列时，它都会隐藏我的所有内容。

完整代码如下。主要是重复 5 次的同一件事。谢谢！

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 And Target.Row = 3 And Target.Value = "Cashback" Then
        Application.Rows("4:7").Select
        Application.Selection.EntireRow.Hidden = False
    Else
        Application.Rows("4:7").Select
        Application.Selection.EntireRow.Hidden = True
    End If
    
        If Target.Column = 1 And Target.Row = 3 And Target.Value = "Content" Then
        Application.Rows("8:25").Select
        Application.Selection.EntireRow.Hidden = False
    Else
        Application.Rows("8:25").Select
        Application.Selection.EntireRow.Hidden = True
    End If
    If Target.Column = 1 And Target.Row = 3 And Target.Value = "Price Comparison" Then
        Application.Rows("26:40").Select
        Application.Selection.EntireRow.Hidden = False
    Else
        Application.Rows("26:40").Select
        Application.Selection.EntireRow.Hidden = True
    End If
    
    If Target.Column = 1 And Target.Row = 3 And Target.Value = "Technology" Then
        Application.Rows("41:52").Select
        Application.Selection.EntireRow.Hidden = False
    Else
        Application.Rows("41:52").Select
        Application.Selection.EntireRow.Hidden = True
    End If
    
        If Target.Column = 1 And Target.Row = 3 And Target.Value = "Vouchers" Then
        Application.Rows("53:79").Select
        Application.Selection.EntireRow.Hidden = False
    Else
        Application.Rows("53:79").Select
        Application.Selection.EntireRow.Hidden = True
    End If
    
            If Target.Column = 1 And Target.Row = 3 And Target.Value = "All" Then
        Application.Rows("3:200").Select
        Application.Selection.EntireRow.Hidden = False
    End If
    
    
End Sub

Answer 1

我对代码进行了一些重构，使其更高效，易于理解/维护，最重要的是，满足要求。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A3")) Is Nothing and Target.Cells.Count = 1 Then
    Application.ScreenUpdating = False
    Me.Rows("4:200").EntireRow.Hidden = True
    Select Case Target.Value
        Case Is = "Cashback": Me.Rows("4:7").EntireRow.Hidden = False
        Case Is = "Content": Me.Rows("8:25").EntireRow.Hidden = False
        Case Is = "Price Comparison": Me.Rows("26:40").EntireRow.Hidden = False
        '... Continue with rest of scenarios ...
        Case Is = "All": Me.Rows("4:200").EntireRow.Hidden = False
    End Select
End If

End Sub

Answer 2

试试这样...

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 1 And Target.Row = 3 Then
        If Target.Value = "Cashback" Then
            Rows("4:7").EntireRow.Hidden = False
        Else
            Application.Rows("4:7").Select
            Rows("4:7").EntireRow.Hidden = True
        End If
        If Target.Value = "Content" Then
            Rows("8:25").EntireRow.Hidden = False
        Else
            Rows("8:25").EntireRow.Hidden = True
        End If
        If Target.Value = "Price Comparison" Then
            Rows("26:40").EntireRow.Hidden = False
        Else
            Rows("26:40").EntireRow.Hidden = True
        End If
        If Target.Value = "Technology" Then
            Rows("41:52").EntireRow.Hidden = False
        Else
            Rows("41:52").EntireRow.Hidden = True
        End If
        If Target.Value = "Vouchers" Then
            Rows("53:79").EntireRow.Hidden = False
        Else
            Rows("53:79").EntireRow.Hidden = True
        End If
        If Target.Value = "All" Then
            Rows("3:200").EntireRow.Hidden = False
        End If
    End If
End Sub

Answer 3

问题出在Select语句的Else。试试这段代码。

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 14 Apr 2017
    Dim Rng As Range
    With Target
        If .Address = Cells(3, 1).Address Then
            Application.ScreenUpdating = False
            Set Rng = Range.Rows("3:200")
            If .Value <> "All" Then
                Rng.Hidden = True
                Select Case .Value
                    Case "Cashback"
                        Set Rng = Rows("4:7")
                    Case "Content"
                        Set Rng = Rows("8:25")
                    Case "Price Comparison"
                        Set Rng = Rows("26:40")
                    Case "Technology"
                        Set Rng = Rows("41:52")
                    Case "Vouchers"
                        Set Rng = Rows("53:79")
                End Select
            End If
            Rng.Hidden = False
            Rng.Select
            Application.ScreenUpdating = False
        End If
    End With
End Sub