Excel VBA 切换隐藏/取消隐藏代码花费的时间太长

Question

我希望加快下面需要很长时间才能完成的第一个代码。 如果列 H 中的单元格包含文本：“标题”，它只是隐藏/取消隐藏行。 我在下面有一个更好的代码（来自堆栈），我经常使用它来切换范围，但我似乎无法将其调整为 IF。 我已经有太多的命名范围了。

Sub Hide_Columns_Toggle()
    Dim c As Range
    
    For Each c In Columns("H:H").Cells
        If c.Value = "Header" Then
        c.EntireRow.Hidden = Not c.EntireRow.Hidden
        End If
    Next c 
End Sub

范围的常规代码：

Sub ToggleHiddenRow(rng As Range)
  With rng.EntireRow
    .Hidden = Not .Hidden
  End With
End Sub


Sub Name_1()
        ToggleHiddenRow ActiveSheet.Range("Named_Range_1")
End Sub

非常感谢任何帮助。

Answer 1

要加快速度，您可以：

1. 限制您在工作表上引用的单元格数量
2. 在一次操作中隐藏/取消隐藏所有需要的行
3. 仅隐藏/取消隐藏要更改可见性的行

该代码通过

1. 创建一个范围，从最后一个测试行延伸到工作表末端
2. 使用Match定位包含测试值的下一个单元格
3. 测试是否需要更改行可见性
4. 跟踪两组范围，一组隐藏，另一组未隐藏
5. 一次对所有行应用隐藏/取消隐藏
6. 概括代码以允许您指定工作表、列、测试值和隐藏模式

Option Explicit

Enum HideMode
    Hide = 0
    Show = 1
    Toggle = 2
End Enum
 
Sub Demo()
    Hide_Columns_Toggle 8, "Header", HideMode.Toggle
End Sub

Sub Hide_Columns_Toggle(Col As Long, TestValue As Variant, Mode As HideMode, Optional ws As Worksheet)
    Dim rng As Range
    Dim rToHide As Range
    Dim rToShow As Range
    Dim rw As Variant
    
    ' Default to ActiveSheet
    If ws Is Nothing Then Set ws = ActiveSheet
    
    Set rng = ws.Range(ws.Cells(1, Col), ws.Cells(ws.Rows.Count, Col))
    rw = Application.Match(TestValue, rng, 0)
    Do Until IsError(rw)
        Select Case Mode
            Case HideMode.Toggle
                If rng.Cells(rw, 1).EntireRow.Hidden = True Then
                    AddToRange rToShow, rng.Cells(rw, 1)
                Else
                    AddToRange rToHide, rng.Cells(rw, 1)
                End If
            Case HideMode.Hide
                If rng.Cells(rw, 1).EntireRow.Hidden = False Then
                    AddToRange rToHide, rng.Cells(rw, 1)
                End If
            Case HideMode.Show
                If rng.Cells(rw, 1).EntireRow.Hidden = True Then
                    AddToRange rToShow, rng.Cells(rw, 1)
                End If
        End Select
        Set rng = ws.Range(rng.Cells(rw + 1, 1), ws.Cells(ws.Rows.Count, Col))
        rw = Application.Match(TestValue, rng, 0)
    Loop
    
    If Not rToHide Is Nothing Then
        rToHide.EntireRow.Hidden = True
    End If
    If Not rToShow Is Nothing Then
        rToShow.EntireRow.Hidden = False
    End If
End Sub

Private Sub AddToRange(rng As Range, AddRange As Range)
    If rng Is Nothing Then
        Set rng = AddRange
    Else
        Set rng = Application.Union(rng, AddRange)
    End If
End Sub

Answer 2

这就是我的意思：

Sub ToggleRowsVis()
    Dim rngHide As Range, rngShow As Range, c As Range, rw As Range
    For Each c In ActiveSheet.Range("Names").Cells
        If c.Value = "Header" Then
            Set rw = c.EntireRow
            If rw.Hidden Then
                BuildRange rngShow, c.EntireRow
            Else
                BuildRange rngHide, c.EntireRow
            End If
        End If
    Next c
    If Not rngHide Is Nothing Then rngHide.Rows.Hidden = True
    If Not rngShow Is Nothing Then rngShow.Rows.Hidden = False
End Sub

'utility sub for building ranges using Union
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

Answer 3

好的，我想我找到了你们的灵感的中间立场，我将 H1:H3000 作为命名范围（名称），然后使用该 1 范围筛选我可以放入其中的不同文本（标题/详细信息等等）。

Sub Hide_Columns_Toggle2()

    For Each c In ActiveSheet.Range("Names")
        If c.Value = "Header" Then
        c.EntireRow.Hidden = Not c.EntireRow.Hidden
        End If
    Next c
End Sub

谢谢各位。