使用 VBA 以最小延迟动态隐藏/取消隐藏多个范围

Question

早上好，

我正在尝试创建一个 VBA 脚本，该脚本将允许我正在创建的工作表根据下拉菜单中的选择动态隐藏或取消隐藏行。我的脚本非常适合较小的数据集，但是因为我有 35 个不同的范围，每个范围 26 行，所以速度非常慢。

我在这里看到了一些类似解决方案的解决方案，但我无法让它们适用于我的特定情况。我想要做的是收集单元格 B15 到 B41 中的值并隐藏其中包含空白值的所有行，然后对我拥有的剩余 34 个范围重复此过程。

上述范围内的每个单元格中都有一个公式，可以返回一个“”值（这是我要隐藏的行）。

有没有办法做到这一点，如果我需要提供任何其他信息怎么办？

   'Turns off worksheet protection to allow for hiding and unhiding of rows
   
    ActiveSheet.Unprotect "xxxx"
   
   'Turns off screen updating and animations while hiding and unhiding rows
   
    Application.EnableAnimations = False
    Application.ScreenUpdating = False
      
    Hide1
    Hide2
    Hide3
    Hide4
    Hide5
    Hide6
    Hide7
    Hide8
    Hide9
    Hide10
    Hide11
    Hide12
    Hide13
    Hide14
    Hide15

    Application.ScreenUpdating = True
    Application.EnableAnimations = True
    
    ActiveSheet.Protect "xxxx"
    
End Sub

Sub Hide1()

Application.EnableEvents = False
Application.EnableAnimations = False
Application.ScreenUpdating = False

'Run #1

    If Range("B15").Value = "" Then
        Rows(15).EntireRow.Hidden = True
    Else
        Rows(15).EntireRow.Hidden = False
    End If
    If Range("B16").Value = "" Then
        Rows(16).EntireRow.Hidden = True
    Else
        Rows(16).EntireRow.Hidden = False
    End If
    If Range("B17").Value = "" Then
        Rows(17).EntireRow.Hidden = True
    Else
        Rows(17).EntireRow.Hidden = False
    End If
    If Range("B18").Value = "" Then
        Rows(18).EntireRow.Hidden = True
    Else
        Rows(18).EntireRow.Hidden = False
    End If
    If Range("B19").Value = "" Then
        Rows(19).EntireRow.Hidden = True
    Else
        Rows(19).EntireRow.Hidden = False
    End If
    If Range("B20").Value = "" Then
        Rows(20).EntireRow.Hidden = True
    Else
        Rows(20).EntireRow.Hidden = False
    End If
    If Range("B21").Value = "" Then
        Rows(21).EntireRow.Hidden = True
    Else
        Rows(21).EntireRow.Hidden = False
    End If
    If Range("B22").Value = "" Then
        Rows(22).EntireRow.Hidden = True
    Else
        Rows(22).EntireRow.Hidden = False
    End If
    If Range("B23").Value = "" Then
        Rows(23).EntireRow.Hidden = True
    Else
        Rows(23).EntireRow.Hidden = False
    End If
    If Range("B24").Value = "" Then
        Rows(24).EntireRow.Hidden = True
    Else
        Rows(24).EntireRow.Hidden = False
    End If
    If Range("B25").Value = "" Then
        Rows(25).EntireRow.Hidden = True
    Else
        Rows(25).EntireRow.Hidden = False
    End If
    If Range("B26").Value = "" Then
        Rows(26).EntireRow.Hidden = True
    Else
        Rows(26).EntireRow.Hidden = False
    End If
    If Range("B27").Value = "" Then
        Rows(27).EntireRow.Hidden = True
    Else
        Rows(27).EntireRow.Hidden = False
    End If
    If Range("B28").Value = "" Then
        Rows(28).EntireRow.Hidden = True
    Else
        Rows(28).EntireRow.Hidden = False
    End If
    If Range("B29").Value = "" Then
        Rows(29).EntireRow.Hidden = True
    Else
        Rows(29).EntireRow.Hidden = False
    End If
    If Range("B30").Value = "" Then
        Rows(30).EntireRow.Hidden = True
    Else
        Rows(30).EntireRow.Hidden = False
    End If
    If Range("B31").Value = "" Then
        Rows(31).EntireRow.Hidden = True
    Else
        Rows(31).EntireRow.Hidden = False
    End If

    Application.EnableEvents = True
    Application.EnableAnimations = True
    Application.ScreenUpdating = True
    
End Sub

Answer 1

请尝试下一个代码。设置后，它将隐藏所有具有由公式返回的空值的行。可以选择firstR和lastR来处理特定数量的行：

Sub Hide1()
 Dim sh As Worksheet, lastR As Long, firstR As Long
 Dim rng As Range, rngH As Range, arr, i As Long
 
 Set sh = ActiveSheet 'use here the sheet you need
 lastR = sh.Range("B" & sh.rows.Count).End(xlUp).row 'last row on B:B
 firstR = 15          'first row of the range to be processed
 Set rng = sh.Range("B" & firstR & ":B" & lastR)
 rng.EntireRow.Hidden = False       'show all rows in the range

 arr = rng.Value                    'place the range in an array for faster iteration
 For i = 1 To UBound(arr)
    If arr(i, 1) = "" Then
        If rngH Is Nothing Then    'set the range to keep the cells where the rows must be hidden
            Set rngH = rng.cells(i, 1)
        Else
           Set rngH = Union(rngH, rng.cells(i, 1))
        End If
    End If
 Next
 'hide the rows at once:
 If Not rngH Is Nothing Then rngH.EntireRow.Hidden = True
End Sub

Answer 2

隐藏空白行

• 调整常量部分中的值。

Option Explicit

Sub HideBlankRows()
    
    Const fCellAddress As String = "B16"
    Const crgCount As Long = 35
    Const crgSize As Long = 16 ' maybe 26 ?
    Const crgGap As Long = 5
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim crg As Range: Set crg = ws.Range(fCellAddress).Resize(crgSize)
    Dim crgOffset As Long: crgOffset = crgSize + crgGap
    Dim rg As Range: Set rg = crg
    
    Dim n As Long
    For n = 2 To crgCount
        Set crg = crg.Offset(crgOffset)
        Set rg = Union(rg, crg)
    Next n
    
    Dim drg As Range
    Dim cCell As Range
    
    For Each cCell In rg.Cells
        If Len(CStr(cCell.Value)) = 0 Then
            If drg Is Nothing Then
                Set drg = cCell
            Else
                Set drg = Union(drg, cCell)
            End If
        End If
    Next cCell
    If drg Is Nothing Then Exit Sub
 
    rg.EntireRow.Hidden = False
    drg.EntireRow.Hidden = True
    
End Sub