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

謝謝各位。