宏有效但太慢

Question

我發現這個宏可以完成這項工作，但執行需要很長時間。 我希望 go 在第 4 到 350 行而不是所有行上。 另外，我希望它不要詢問哪個工作表，而是在工作表名稱 Data 上執行。 該宏用於刪除空行。

Sub DeleteBlankRows()
    Dim wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
        lngColCounter As Long
    Dim blnAllBlank As Boolean
    Dim UserInputSheet As String
    
    UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")
    
    Set wks = Worksheets(UserInputSheet)
    
    With wks
        'Now that our sheet is defined, we'll find the last row and last column
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
    
        'Since we need to delete rows, we start from the bottom and move up
        For lngIdx = lngLastRow To 1 Step -1
    
            'Start by setting a flag to immediately stop checking
            'if a cell is NOT blank and initializing the column counter
            blnAllBlank = True
            lngColCounter = 2
    
            'Check cells from left to right while the flag is True
            'and the we are within the farthest-right column
            While blnAllBlank And lngColCounter <= lngLastCol
    
                'If the cell is NOT blank, trip the flag and exit the loop
                If .Cells(lngIdx, lngColCounter) <> "" Then
                    blnAllBlank = False
                Else
                    lngColCounter = lngColCounter + 1
                End If
    
            Wend
    
            'Delete the row if the blnBlank variable is True
            If blnAllBlank Then
                .Rows(lngIdx).Delete
            End If
    
        Next lngIdx
    End With
    
    MsgBox "Blank rows have been deleted."

End Sub

Answer 1

如果該行中的所有單元格都是空白的，您似乎想要刪除行。

您的實際代碼檢查數據范圍中每一行和每一列的每個單元格。

您可以通過檢查整行是否為空白來提高速度。 例如：

黃色單元格是空白單元格 紅色單元格是完整的空白行（該行中的所有單元格都是空白）。

此代碼將刪除紅色行，這意味着它將刪除整行，但前提是所有單元格均為空白。

Dim rng As Range
Dim i As Long
Dim MyRow As Range, DeleteRange As Range
Dim MiF As WorksheetFunction

Set MiF = WorksheetFunction

Set rng = Range("C7:M34") 'define range here

For i = 1 To rng.Rows.Count
    If MiF.CountA(rng.Rows(i)) = 0 Then
        If DeleteRange Is Nothing Then
            Set DeleteRange = rng.Rows(i) 'first time, we can't use Union
        Else
            'we unite all complete blank rows into one final "big" range
            Set DeleteRange = Union(DeleteRange, rng.Rows(i))
        End If
    End If
Next i

'we delete if something is found
If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete

'clear variables
Set DeleteRange = Nothing
Set rng = Nothing
Set MiF = Nothing

執行代碼后output是這樣的。