隐藏细胞基于下拉，保持地激活未被选择时

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