vba - 使用 Excel 2013 隐藏行

Question

因此，我尝试基于几种不同的条件使用 VBA 隐藏 Excel 2013 中的行:

• 如果部分标题为“未使用”，则隐藏部分。每个部分都是一个命名范围，以使其更容易。
• 如果行是“Cblank”命名范围的一部分，则隐藏它。
• 现在是最困难的部分 - 对于 Range("COnTest") 中的每个单元格，如果 C.Value = ""且 C.Columns(41).Value = ""然后隐藏它们。

Range("CNonTest") 位于 C 列中，应检查的额外列是 AQ 列。

为了增加难度，我需要在每次 8 个不同验证框中的任何一个发生更改时运行此宏。

下面是我目前拥有的代码:

    Sub CompHide()

    With Sheets("Comparison").Cells
       .EntireRow.Hidden = False

    If Range("C9").Value = "Unused" Then
        Range("CMarket1").EntireRow.Hidden = True
    End If

    If Range("C115").Value = "Unused" Then
        Range("CMarket2").EntireRow.Hidden = True
    End If

    If Range("C221").Value = "Unused" Then
        Range("CMarket3").EntireRow.Hidden = True
    End If

    If Range("C329").Value = "Unused" Then
        Range("CMarket4").EntireRow.Hidden = True
    End If

    If Range("C437").Value = "Unused" Then
        Range("CMarket5").EntireRow.Hidden = True
    End If

    If Range("C545").Value = "Unused" Then
        Range("CMarket6").EntireRow.Hidden = True
    End If

    If Range("C653").Value = "Unused" Then
        Range("CMarket7").EntireRow.Hidden = True
    End If

    If Range("C761").Value = "Unused" Then
        Range("CMarket8").EntireRow.Hidden = True
    End If

    If Range("C869").Value = "Unused" Then
        Range("CMarket9").EntireRow.Hidden = True
    End If

    If Range("C977").Value = "Unused" Then
        Range("CMarket10").EntireRow.Hidden = True
    End If

    For Each C In Range("CNonTest")
        If C.Value = "" And C.Columns(41).Value = "" Then
            C.EntireRow.Hidden = True
        End If
    Next



    Range("CBlank").EntireRow.Hidden = True

    End With
End Sub

然后在工作表上我有以下代码:

    Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Me.Range("A4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("D4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("G4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("K4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("AO4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("AR4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("AU4")) Is Nothing _
    Or _
    Intersect(Target, Me.Range("AY4")) Is Nothing _
    Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

对于工作表代码我也尝试过但无济于事

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Me.Range("A4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("D4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("G4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("K4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("AO4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("AR4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True



If Intersect(Target, Me.Range("AU4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True


If Intersect(Target, Me.Range("AY4")) Is Nothing Then Exit Sub

    Application.EnableEvents = False 'to prevent endless loop
    Application.ScreenUpdating = False

    Call CompHide

    Application.ScreenUpdating = True
    Application.EnableEvents = True


End Sub

这段代码似乎工作正常，当我使用 F8 单步执行 CompHide 时，它​​工作得很好。所以我认为问题出在工作表本身的代码上。您将在该代码中看到一条注释，其中提到防止无限循环，该注释来自一些我手下的代码，不太确定它的用途，但根据我将留下的注释计算出来。

当我更改验证框时，它不再隐藏所有正确的内容，仅隐藏其中的一些内容。幸运的是，我还没有看到它隐藏了一些不应该隐藏的东西。我说不再是因为起初这段代码只查看第一个验证框，但现在它查看全部 8 个。

Answer 1

对事件处理程序的一些调整:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range

    On Error GoTo haveError

    Set rng = Application.Intersect(Target, Me.Range("A4,D4,G4,K4,AO4,AR4,AU4,AY4"))

    If Not rng Is Nothing Then
        Application.EnableEvents = False 'to prevent endless loop
        Application.ScreenUpdating = False
        CompHide
        Application.EnableEvents = True
    End If
    Exit Sub

haveError:
    'always re-enable events
    '  (screenupdating setting is not persistent)...
    Application.EnableEvents = True

End Sub

另一部分:

Sub CompHide()

    Dim sht As Worksheet, C As Range

    Set sht = Sheets("Comparison")
    sht.Rows.Hidden = False

    SetRowVis "C9", "CMarket1"
    SetRowVis "C115", "CMarket2"
    '...and the rest

    For Each C In sht.Range("CNonTest")
        If C.Value = "" And C.EntireRow.Columns(43).Value = "" Then
            C.EntireRow.Hidden = True
        End If
    Next

    sht.Range("CBlank").EntireRow.Hidden = True
End Sub

'utility sub...
Sub SetRowVis(addr As String, rngName As String)
    With Sheets("Comparison")
        If .Range(addr).Value = "Unused" Then
            .Range(rngName).EntireRow.Hidden = True
        End If
    End With
End Sub