Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.1k views
in Technique[技术] by (71.8m points)

excel - How can I speed up this For Each loop in VBA?

I have an Worksheet_Change macro that hides/unhides rows depending on the choice a user makes in a cell with a data validation list.

The code takes a minute to run. It's looping over c.2000 rows. I'd like it to take closer to a few seconds so it becomes a useful user tool.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    'Exit the routine early if there is an error
    On Error GoTo EExit

    'Manage Events
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    'Declare Variables
    Dim rng_DropDown As Range
    Dim rng_HideFormula As Range
    Dim rng_Item As Range

    'The reference the row hide macro will look for to know to hide the row
    Const str_HideRef As String = "Hide"

    'Define Variables
    'The range that contains the week selector drop down
    Set rng_DropDown = Range("rng_WeekSelector")
    'The column that contains the formula which indicates if a row should 
    'be hidden c.2000 rows
    Set rng_HideFormula = Range("rng_HideFormula")

    'Working Code
    'Exit sub early if the Month Selector was not changed
    If Not Target.Address = rng_DropDown.Address Then GoTo EExit

    'Otherwise unprotect the worksheet
    wks_DailyPlanning.Unprotect (str_Password)

    'For each cell in the hide formula column
    For Each rng_Item In rng_HideFormula

        With rng_Item
            'If the cell says "hide"
            If .Value2 = str_HideRef Then

                'Hide the row
                .EntireRow.Hidden = True

            Else
                'Otherwise show the row
                .EntireRow.Hidden = False

            End If
        End With
    'Cycle through each cell
    Next rng_Item

    EExit:
    'Reprotect the sheet if the sheet is unprotected
    If wks_DailyPlanning.ProtectContents = False Then wks_DailyPlanning.Protect (str_Password)


    'Clear Events
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

I have looked at some links provided by other users on this website and I think the trouble lies in the fact I'm having to iterate through each row individually.

Is it possible to create something like an array of .visible settings I can apply to the entire range at once?

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

I'd suggest copying your data range to a memory-based array and checking that, then using that data to adjust the visibility of each row. It minimizes the number of interactions you have with the worksheet Range object, which takes up lots of time and is a big performance hit for large ranges.

Sub HideHiddenRows()
    Dim dataRange As Range
    Dim data As Variant
    Set dataRange = Sheet1.Range("A13:A2019")
    data = dataRange.Value

    Dim rowOffset As Long
    rowOffset = IIf(LBound(data, 1) = 0, 1, 0)

    ApplicationPerformance Flag:=False

    Dim i As Long
    For i = LBound(data, 1) To UBound(data, 1)
        If data(i, 1) = "Hide" Then
            dataRange.Rows(i + rowOffset).EntireRow.Hidden = True
        Else
            dataRange.Rows(i + rowOffset).EntireRow.Hidden = False
        End If
    Next i
    ApplicationPerformance Flag:=True
End Sub

Public Sub ApplicationPerformance(ByVal Flag As Boolean)
    Application.ScreenUpdating = Flag
    Application.DisplayAlerts = Flag
    Application.EnableEvents = Flag
End Sub

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...