Excel：需要删除大约 100 万个空白行

Question

我有一个来自我们的一位客户的 excel 文件，该文件有近 100 万行空白行。

我确实尝试在 C 列（称为项目）上过滤它，它是空白的，然后选择所有行并尝试删除。它几乎冻结了近几个小时，但最后我杀死了 excel 进程。

我也在 VBA 脚本下尝试过，但它显示“r.rows(i).Delete”的实际行只是冻结了。这是第一个删除实例本身。

我也将 Excel 文件设置为手动进行公式计算。

我不介意整个工作需要几个小时。我可以把它留一夜，然后早上检查。

如果有 VB.NET 或 C# 也可以。

更新 1：我无法批量删除 1 到 1048576 行之间的行，我需要删除 C 列为空白的那些行（这意味着该行为空白）。

更新 2：我将以下删除标记为答案，但我最终通过将 GOOD 行复制到另一个工作表来解决问题。

请提出处理这种情况的最佳方案。

VBA 源代码

Sub BlankRowDelete()

Dim r As Range, rows As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
ActiveSheet.AutoFilterMode = False

Set r = ActiveSheet.Range("A1:A1048576")
rows = r.rows.Count
For i = rows To 1 Step (-1)
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then
        r.rows(i).Delete
        RowDeleted = RowDeleted + 1
    Else
        NotDeleted = NotDeleted + 1
    End If
    totalcnt = totalcnt + 1
    If RowDeleted = 100 Then
       TotalDeleted = TotalDeleted + RowDeleted
       RowDeleted = 0
       Debug.Print "count now is " + totalcnt
    End If
    Application.StatusBar = "Row count is " + totalcnt
Next
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
ActiveSheet.AutoFilterMode = True

结束子

Answer 1

按 C 列升序对文档进行排序。空行会到最后，所以应该很容易删除。

Answer 2

我对您的代码进行了一些更新，例如 doevents，打开状态栏，因为 oyu 正在写入它，并在需要时更新屏幕并在您写出数值时添加 cstr()。我运行这个没有问题。如 cmets 所述，这只会删除单元格 A 而不是整行

Sub BlankRowDelete()
On Error GoTo myError
Dim r As Range, rows As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
ActiveSheet.AutoFilterMode = False

Set r = ActiveSheet.Range("C1:C1048576") 
rows = r.rows.Count
For i = rows To 1 Step (-1)
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then
        r.rows(i).EntireRow.Delete
        RowDeleted = RowDeleted + 1
    Else
        NotDeleted = NotDeleted + 1
    End If
    totalcnt = totalcnt + 1
    If RowDeleted = 100 Then

       Application.ScreenUpdating = True
       TotalDeleted = TotalDeleted + RowDeleted
       RowDeleted = 0
                   'you can uncomment this but since this is a dup since writting to statusbar (imo)
      'Debug.Print "count now is " + CStr(totalcnt)

       Application.ScreenUpdating = False
    End If
    Application.StatusBar = "Row count is " + CStr(totalcnt)
    DoEvents
Next
myError:
If Err.Number <> 0 Then
MsgBox CStr(i) & ": " & Err.Description
End If
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
ActiveSheet.AutoFilterMode = True
End Sub