在另一行被隐藏后，基于单元格值的隐藏行变为未隐藏

Question

我试图根据另一个工作表中单元格的值隐藏另一个工作表中的一些行，我似乎有 VBA 代码在一定程度上工作，但似乎当我将值更改为“否”时隐藏某一行，然后为另一个单元格选择“否”，只有与第二个问题关联的行被隐藏，第一组行再次变得可见。有关上下文中的错误，请参见下文

Sub Worksheet_Change(ByVal Target As Range)

If (Target.Row = 12) And (Target.Column = 4) And (Target = "No") Then
Worksheets("Additional Procedures").Rows("13:16").EntireRow.Hidden = True
Else
Worksheets("Additional Procedures").Rows("13:16").EntireRow.Hidden = False
End If

If (Target.Row = 13) And (Target.Column = 4) And (Target = "No") Then
Worksheets("Additional Procedures").Rows("17:18").EntireRow.Hidden = True
Else
Worksheets("Additional Procedures").Rows("17:18").EntireRow.Hidden = False
End If

End Sub

因此，在上下文中，如果工作表单元格 D12 中的值为“否”，那么第 13:16 行将隐藏在工作表“附加程序”中但是那么如果我也有单元格 D13 的值为“否”，则第 13:16 行变为可见，第 17:18 行变为隐藏。如果单元格 D12 和 D13 的值都为“否”，我希望第 13:18 行保持隐藏状态

我还写了这段代码，仅当单元格 D21:D23 中的值都为“否”时才隐藏行 32:35。如果这是导致问题的原因，我已将其包括在内：

Dim Count As Integer
Dim Range As Variant
Count = 0
Range = Worksheets("Risk Assessment").Range("D21:D23")

For Each Cell In Range
If Cell = "No" Then
Count = Count + 1
End If
Next Cell

If Count = 3 Then
Sheets("Additional Procedures").Select
Worksheets("Additional Procedures").Rows("32:35").EntireRow.Hidden = True
Else
Worksheets("Additional Procedures").Rows("32:35").EntireRow.Hidden = False
End If

提前感谢你们提供的任何建议

Answer 1

隐藏范围内的行

标准模块（例如Module1）

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Loops through the cells of a given range (SourceRange) and
'               checks their values against a given value (SourceValue).
'               If the values are the same it hides (otherwise it shows)
'               the rows of another given range (HideRows).
' Inputs
'   SourceRange   The range where the value is going to be searched for.
'   SourceValue   The value that is searched for.
'   HideRows      The range whose rows will be hidden or shown.
'   findOneOnly   By default (False), the values of all cells of SourceRange
'                 have to be equal to SourceValue. When set to True, only
'                 one value has to be equal. This has no effect
'                 if SourceRange contains only one cell.
' Remarks:      The comparison is case-sensitive i.e. e.g. A <> a.
'               SourceValue is declared as Variant to be able to hold
'               different data types.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub HideRows(SourceRange As Range, _
             ByVal SourceValue As Variant, _
             HideRows As Range, _
             Optional ByVal findOneOnly As Boolean = False)
    
    Dim Data As Variant: Data = SourceRange.Value
    
    If Not IsArray(Data) Then GoTo doOne Else GoTo doMulti
        
doOne:
    If Not IsError(Data) Then
        If Data = SourceValue Then GoTo doHideRows Else GoTo doShowRows
    Else
        GoTo doShowRows
    End If
    
doMulti:
    Dim i As Long, j As Long
    For i = 1 To UBound(Data)
        For j = 1 To UBound(Data, 2)
            If Not IsError(Data(i, j)) Then
                If Data(i, j) = SourceValue Then
                    If findOneOnly Then GoTo doHideRows
                Else
                    If Not findOneOnly Then GoTo doShowRows
                End If
            Else
                If Not findOneOnly Then GoTo doShowRows
            End If
        Next j
    Next i
    If findOneOnly Then GoTo doShowRows Else GoTo doHideRows
    
doHideRows:
    HideRows.EntireRow.Hidden = True
    Exit Sub

doShowRows:
    HideRows.EntireRow.Hidden = False
    Exit Sub

End Sub

表格模块（例如Sheet1）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const wsName As String = "Additional Procedures"
    Const Criteria As Variant = "No"
    Dim CheckAddress As Variant
    CheckAddress = Array("D12", "D13", "D21:D23")
    Dim HideRowsAddress As Variant
    HideRowsAddress = Array("13:16", "17:18", "32:35")

    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(wsName)
    
    Dim j  As Long
    For j = 0 To UBound(CheckAddress)
        If Not Intersect(Target, Range(CheckAddress(j))) Is Nothing Then
            HideRows Range(CheckAddress(j)), Criteria, _
                ws.Rows(HideRowsAddress(j))
        End If
    Next j

End Sub

如果在D21:D23 范围内仅找到一个No 足以隐藏行32:35，请使用True：

            HideRows Range(CheckAddress(j)), Criteria, _
                ws.Rows(HideRowsAddress(j)), True

Answer 2

这段代码可以做你想做的事。如果没有，它应该为您提供如何构建 IF 条件的新动力。请尝试一下。

Sub Worksheet_Change(ByVal Target As Range)

    Dim TgtRows     As String
    
    With Target
        If .Column = 4 Then
            Select Case .Row
                Case 12
                    TgtRows = "13:16"
                Case 13
                    TgtRows = "17:18"
            End Select
            If Len(TgtRows) Then
                ' assuming that Target is on Worksheets("Additional Procedures")
                '                                 comparison is case insensitive
                Rows(TgtRows).EntireRow.Hidden = (StrComp(.Value, "no", vbTextCompare) = 0)
            End If
        End If
    End With
End Sub