Question

在我的工作簿中的所有工作表中尝试使用Union和范围加快删除空列，除了＆＃34; AA＆＃34;和＆＃34;单词频率＆＃34;

之前的表格示例：

之后的工作表示例（注意，我需要编写单独的脚本来移动关键字，您无法查看所有关键字，但只留下包含数据的列）：

在我搜索一种加快删除工作表中列的方法时，如果列为空（标题除外），@ chrisneilsen指示我引用该帖子Improving the performance of FOR loop 。

该主题揭示了单独删除列会显着降低性能的事实。通过定义＆＃34; master＆＃34;来提高脚本速度。范围包括要删除的所有范围（列）（使用Union），然后简单地删除＆＃34; master＆＃34;范围。

作为VBA菜鸟，我过去常常通过参考来了解范围，Union，UBound和LBound来理解上述话题中的代码：

Excel-Easy.com: Using UBound and LBound ， Dynamic Arrays (Using ReDim)
Youtube：Using UNION method to select (and modify) multiple ranges

我的旧（慢）脚本可以正常工作，但大约需要3个小时才能运行~30张并删除每张约100列：

Sub Delete_No_Data_Columns()

    Dim col As Long
    Dim h 'to store the last columns/header

    h = Range("E1").End(xlToRight).Column 'find the last column with the data/header

    Application.ScreenUpdating = False
    For col = h To 5 Step -1
        If Application.CountA(Columns(col)) = 1 Then Columns(col).Delete
    Next col

End Sub

几乎工作脚本（对于一张表），使用与上述thread中的@chrisneilsen代码相同的方法。当我运行它时，它没有做任何事情，但@chrisneilsen注意到有2个语法错误（Column。而不是Columns。）而且我混合了一个隐式ActiveSheet（通过使用没有限定符的Columns））使用明确的工作表Worksheets("Ball Shaker")。代码中的错误在下面进行了评论。

Sub Delete_No_Data_Columns_Optimized()

    Dim col As Long
    Dim h 'to store the last columns/header
    Dim EventState As Boolean, CalcState As XlCalculation, PageBreakState As Boolean
    Dim columnsToDelete As Range
    Dim ws as Worksheet '<<<<<<<<< Fixing Error (qualifying "Columns." properly)

    On Error GoTo EH:
    'Optimize Performance

    Application.ScreenUpdating = False
    EventState = Application.EnableEvents
    Application.EnableEvents = False

    CalcState = Application.Calculation
    Application.Calculation = xlCalculationManual

    PageBreakState = ActiveSheet.DisplayPageBreaks
    ActiveSheet.DisplayPageBreaks = False

' <<<<<<<<<<<<< MAIN CODE >>>>>>>>>>>>>>

    Set ws = ActiveSheet

    h = Range("E1").End(xlToRight).Column 'find the last column with the data/header

    '<<<<<<<<<<<<<< Errors corrected below in comments >>>>>>>>>>>>           
    For col = h To 5 Step -1
        If Application.CountA(Column(col)) = 1 Then  
        '<<<<< should be Application.CountA(ws.Columns(col)) = 1
            If columnsToDelete Is Nothing Then

            Set columnsToDelete = Worksheets("Ball Shaker").Column(col)
                'should be columnsToDelete = ws.Columns(col)
            Else
                Set columnsToDelete = Application.Union(columnsToDelete, Worksheets("Ball Shaker").Column(col))
                'should be columnsToDelete = Application.Union(columnsToDelete, ws.Columns(col))
            End If
        End If
    Next col
    '<<<<<<<<<<<<<< End Errors >>>>>>>>>>>>>>>>

    If Not columnsToDelete Is Nothing Then
        columnsToDelete.Delete
    End If

' <<<<<<<<<<<< END MAIN CODE >>>>>>>>>>>>>>

CleanUp:
    'Revert optmizing lines
    On Error Resume Next
    ActiveSheet.DisplayPageBreaks = PageBreakState
    Application.Calculation = CalcState
    Application.EnableEvents = EventState
    Application.ScreenUpdating = True
Exit Sub
EH:
    ' Handle Errors here

    Resume CleanUp
End Sub

在工作簿中所有工作表上运行的工作代码，大约需要6分钟（除了＆＃34; AA＆＃34;＆＃34; Word Frequency＆＃34;工作表，我不会这样做＆＃39;需要格式化）：

Option Explicit

Sub Delete_No_Data_Columns_Optimized_AllSheets()

Dim sht As Worksheet

For Each sht In Worksheets

    If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then
        sht.Activate    'go to that Sheet!
        Delete_No_Data_Columns_Optimized sht.Index  'run the code, and pass the sht.Index _
                                                    'of the current sheet to select that sheet
    End If
Next sht    'next sheet please!


End Sub

Sub Delete_No_Data_Columns_Optimized(shtIndex As Integer)

    Dim col As Long
    Dim h 'to store the last columns/header
    Dim EventState As Boolean, CalcState As XlCalculation, PageBreakState As Boolean
    Dim columnsToDelete As Range
    Dim ws As Worksheet

    Set ws = Sheets(shtIndex)   'Set the exact sheet, not just the one that is active _
                                'and then you will go through all the sheets

    On Error GoTo EH:
    'Optimize Performance

    Application.ScreenUpdating = False
    EventState = Application.EnableEvents
    Application.EnableEvents = False

    CalcState = Application.Calculation
    Application.Calculation = xlCalculationManual

    PageBreakState = ActiveSheet.DisplayPageBreaks
    ActiveSheet.DisplayPageBreaks = False

' <<<<<<<<<<<<< MAIN CODE >>>>>>>>>>>>>>

    h = ws.Range("E1").End(xlToRight).Column 'find the last column with the data/header


    For col = h To 5 Step -1
        If ws.Application.CountA(Columns(col)) = 1 Then  'Columns(col).Delete
            If columnsToDelete Is Nothing Then
                Set columnsToDelete = ws.Columns(col)
            Else
                Set columnsToDelete = Application.Union(columnsToDelete, ws.Columns(col))
            End If
        End If
    Next col

    If Not columnsToDelete Is Nothing Then
        columnsToDelete.Delete
    End If

' <<<<<<<<<<<< END MAIN CODE >>>>>>>>>>>>>>

CleanUp:
    'Revert optmizing lines
    On Error Resume Next
    ActiveSheet.DisplayPageBreaks = PageBreakState
    Application.Calculation = CalcState
    Application.EnableEvents = EventState
    Application.ScreenUpdating = True
Exit Sub
EH:
    ' Handle Errors here

    Resume CleanUp
End Sub

注意：尝试删除列并向左移动，因此包含内部数据的列将在脚本运行后整齐地组合在一起。

这是使用Union和范围删除列的最佳方法吗？任何帮助将不胜感激。

Answer 1

特殊细胞方法实际上不会在这里为您提供如此好的服务。相反，找到工作表中的最后一行数据，只删除列中的单元格直到该行，并将所有内容移到左侧。这比更快<删除整个列！

$ awk '/XXXX/{print min, max;min=max=""} 
     min==""||$2<min{min=$2} 
     max==""||$3>max{max=$3}' file   

100 1900
200 2500
50 2900

使用UNION和范围来加快删除列？

1 个答案: