Question

我在处理一个宏时遇到了一些麻烦。当运行另一个单独的宏时，它用于删除空白（超过一百万行）。如果我能正常工作，我想将两个宏合并在一起。

这是宏：

Sub Test()
DeleteBlankTableRows ActiveSheet.ListObjects(1)
End Sub
Sub DeleteBlankTableRows(ByVal tbl As ListObject)
Dim rng As Range
Set rng = tbl.DataBodyRange ' Get table data rows range.
Dim DirArray As Variant
DirArray = rng.Value2       ' Save table values to array.

' LOOP THROUGH ARRAY OF TABLE VALUES
Dim rowTMP As Long
Dim colTMP As Long
Dim combinedTMP As String
Dim rangeToDelete As Range

'  Loop through rows.
For rowTMP = LBound(DirArray) To UBound(DirArray)
    combinedTMP = vbNullString  ' Clear temp variable.

    ' Loop through each cell in the row and get all values combined.
    For colTMP = 1 To tbl.DataBodyRange.Columns.Count
        combinedTMP = combinedTMP & DirArray(rowTMP, colTMP)
    Next colTMP

    ' Check if row is blank.
    If combinedTMP = vbNullString Then
        ' Row is blank.  Add this blank row to the range-to-delete.
        If rangeToDelete Is Nothing Then
            Set rangeToDelete = tbl.ListRows(rowTMP).Range
        Else
            Set rangeToDelete = Union(rangeToDelete, tbl.ListRows(rowTMP).Range)
        End If
    End If
Next rowTMP

' DELETE BLANK TABLE ROWS (if any)
If Not rangeToDelete Is Nothing Then rangeToDelete.Delete
End Sub

第一次运行时，它会加载并起作用。加载后不到一分钟……没有任何反应（至少在视觉上）。我再次运行它，并且加载很快；这次，空白行在视觉上消失了。

Answer 1

使用显式父表引用以及Index和Max来确定行是否为空白的类似想法。

Option Explicit
Public Sub DeleteRowsIfBlank()
    Dim ws As Worksheet, table As ListObject, arr(), i As Long, counter As Long, unionRng As Range
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set table = ws.ListObjects(1)
    arr = table.DataBodyRange.Value
    counter = table.DataBodyRange.Cells(1, 1).Row
    For i = LBound(arr, 1) To UBound(arr, 1)
        If Application.Max(Application.Index(arr, i, 0)) = 0 Then
            If Not unionRng Is Nothing Then
                Set unionRng = Union(unionRng, table.Range.Rows(counter))
            Else
                Set unionRng = table.Range.Rows(counter)
            End If
        End If
        counter = counter + 1
    Next
    If Not unionRng Is Nothing Then unionRng.Delete
End Sub

一次运行宏不会执行任何操作。再次运行宏

1 个答案: