vba - 删除空列时Excel内存通过屋顶

Question

我创建的一些 Excel VBA 代码有一个非常奇怪的问题。

我不会详细介绍(除非需要)，但我有代码可以过滤并将数据从一张纸复制到另一张纸。

在第二张纸上，它检查空列并删除它们。

我创建了这个小宏来执行删除部分:

Public Sub deleteemptyrows()
    Dim C As Integer
    Range("A1").Select
    Application.CutCopyMode = False
    C = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
    Do Until C = 0
        If WorksheetFunction.CountA(Columns(C)) = 1 Then
            Columns(C).Delete
        End If
        Debug.Print C
        C = C - 1
    Loop
End Sub

现在这个宏工作得非常好并且超快(对于我每次检查的大约 500 列)但是当我在我的 VBA 代码中调用这个宏时会出现问题(在代码复制过滤后的数据之后)。

当它到达 Columns(C).Delete 行时EXCEL.exe 的内存在任务管理器中高达 6 GB，并且逐列运行非常非常慢。

我添加了 Application.CutCopyMode = False行，因为我认为它的内存中可能有复制的数据，但这并没有帮助。

关于如何解决这个问题的任何想法？谢谢!

Answer 1

虽然您需要遍历工作表已使用范围内的列 - 您不需要一个接一个地删除它们。你可以建立一个范围 - 使用 Union - 创建仅包含标题的非连续列范围，然后一次性将它们全部删除。在禁用 Application 的各种属性的情况下使用此技术应该给你一个有效的方法:

Option Explicit

Sub DeleteColumnsEfficiently()

    Dim ws As Worksheet
    Dim rngEmptyColumns As Range
    Dim rngColumn As Range
    Dim wsf As WorksheetFunction
    Dim lngSetting As Long

    ' set a reference to worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' set reference to WorksheetFunction
    Set wsf = Application.WorksheetFunction
    ' initialise range of empty columns
    Set rngEmptyColumns = Nothing

    ' set application settings to optimise ui change
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngSetting = .Calculation
        .Calculation = xlCalculationManual
    End With

    ' loop columns in usedrange
    For Each rngColumn In ws.UsedRange.Columns
        ' check if only header populated
        If wsf.CountA(rngColumn) = 1 Then
            ' if just header - then add to range of columns
            If rngEmptyColumns Is Nothing Then
                Set rngEmptyColumns = rngColumn.Offset
            Else
                Set rngEmptyColumns = Application.Union(rngEmptyColumns, rngColumn)
            End If
        End If
    Next rngColumn

    ' delete columns with only header
    rngEmptyColumns.Delete

    ' reset application settings
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = lngSetting
    End With

End Sub