Excel VBA-For Loop执行时间过长

Question

I have a script which I have designed in order to hide rows that do not contain data, the script looks through column A starting from Row 7. If it finds rows that do not contain values, it will hide those rows from sight. Unfortunately this script takes over 1 minute to run on large sheets in its present form.

Does anybody have suggestions on how to re-write this script in order to make it faster? It needs to run in 5 seconds max

Sub hideAllRows()
Dim Checklist As Variant

    UnlockSheet

    Call Show_Hide("Row", "7:519", True)
    Call Show_Hide("Row", "529:1268", True)

    Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
     For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
       If Checklist(I, 1) <> "" Then
          Rows(I & ":" & I).Select
          Selection.EntireRow.Hidden = False
       End If
     Next I

Answer 1

I have edited your code in order to make things simpler. One of the issues is that your code is firing events "like crazy" (each time you do a Select, an event is fired).

A. If you want to use your code as is, I suggest you add at the beginning

Application.EnableEvents = False

and add in the last line:

Application.EnableEvents = true

B. I suggest that you do the hiding "in one blow", after the loop has ended. Here is how:

Dim Checklist As Variant
dim sRowsToHide as string

UnlockSheet
Application.ScreenUpdating = False
Call Show_Hide("Row", "7:519", True)
Call Show_Hide("Row", "529:1268", True)

Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
 For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
   If Checklist(I, 1) <> "" Then
if sRowsToHide = "" then
   sRowsToHide = I & ":" & I
else
   sRowsToHide = sRowsToHide  & "," & I & ":" & I 
end if
   End If
 Next I

 ActiveSheet.Range(sRowsToHide).EntireRow.Hidden = True

 Application.ScreenUpdating = True

You can use the following line to see how such a thing would work:

ActiveSheet.Range("2:2,14:14,17:17,19:19").EntireRow.Hidden = True

Answer 2

You can try using ScreenUpdating, it will only update the sheet once the loop is done instead of updating every time

Dim Checklist As Variant

    UnlockSheet
Application.ScreenUpdating = False
    Call Show_Hide("Row", "7:519", True)
    Call Show_Hide("Row", "529:1268", True)

    Checklist = ActiveSheet.Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
     For I = UBound(Checklist, 1) To LBound(Checklist, 1) Step -1
       If Checklist(I, 1) <> "" Then
          Rows(I & ":" & I).Select
          Selection.EntireRow.Hidden = False
       End If
     Next I
Application.ScreenUpdating = True

Answer 3

The following will hide all rows that have constants (eg typed values ) in column A.

Sub hide_A_values()
    With ActiveSheet.Columns("A")
        .SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
    End With
End Sub

This next one will hide all rows that have formulas in column A.

Sub hide_A_values()
    With ActiveSheet.Columns("A")
        .SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = True
    End With
End Sub

Finally, this will hide all rows that have constants (eg typed values ) or formulas in column A.

Sub hide_A_values()
    With ActiveSheet.Columns("A")
        Union(.SpecialCells(xlCellTypeConstants), .SpecialCells(xlCellTypeFormulas)).EntireRow.Hidden = True
    End With
End Sub

The problem is that you have to provide error control or risk dealing with the dreaded Runtime error: 1004 No cells were found if there are no constants or formulas to hide. On Error Resume Next typically takes care of this.

Sub hide_A_values()
    With ActiveSheet.Columns("A")
        On Error Resume Next
        .SpecialCells(xlCellTypeConstants).EntireRow.Hidden = True
        .SpecialCells(xlCellTypeFormulas).EntireRow.Hidden = True
        On Error GoTo 0
    End With
End Sub

The only case not covered by those is formulas returning empty strings (eg "") which are not considered truly blank.