[英]Excel VBA Toggle Hide/Unhide code takes too long
I'm hoping to speed up the 1st code below that takes too long to complete.我希望加快下面需要很长时间才能完成的第一个代码。 It just hides/unhides Rows if a cell in Column H contains the text: "Header".如果列 H 中的单元格包含文本:“标题”,它只是隐藏/取消隐藏行。 I've got a better code below that(from stack) that I use regularly to toggle ranges but I can't seem to adjust it to IFs.我在下面有一个更好的代码(来自堆栈),我经常使用它来切换范围,但我似乎无法将其调整为 IF。 I have too many named ranges already.我已经有太多的命名范围了。
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
Regular code for ranges:范围的常规代码:
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
Any help is much much appreciated.非常感谢任何帮助。
To speed this up you can:要加快速度,您可以:
The code achieves this by该代码通过
Match
to locate the next cell containing the test value使用Match
定位包含测试值的下一个单元格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
Here's what I meant:这就是我的意思:
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
Ok I think I found a middle ground with your guys' inspiration, I'll just have H1:H3000 as a named range(Names) and then use that 1 range to sift through different text that I can put in there(Header/Detail etc).好的,我想我找到了你们的灵感的中间立场,我将 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
Thank guys.谢谢各位。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.