使用UNION和范围加快删除列？
尝试使用“ Union和“范围”来加速删除工作簿中除“AA”和“Word频率”之外的所有工作表中的空列
示例工作簿
前面的例子： 
（请注意，我需要编写单独的脚本来将关键字向上移动，但不能看到所有的关键字，但是只剩下包含数据的列）：
在我search的方法中，如果列是空的（除了头部） ，那么加快删除表格中的列的方法是由@chrisneilsen引导的，以提高FOR循环的性能 。
这个线程阐明了删除列会显着降低性能的事实。 通过定义一个“主”范围来包括所有要删除的范围（列）（通过使用Union ），然后简单地删除“主”范围，可以提高脚本速度。
作为一个VBA noob，我习惯了以下引用学习范围， Union ， UBound和LBound了解上面提到的线程中的代码：
Excel-Easy.com： 使用UBound和LBound ， dynamic数组（使用ReDim）
Youtube： 使用UNION方法select（和修改）多个范围
我的旧（慢）脚本可行，但大约需要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
几乎工作的脚本 （对于一张），使用与上述线程中的@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分钟内（除了“AA”和“Word Frequency”工作表，我不需要格式化） 工作代码运行在工作簿中的所有工作表上：
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
注意：尝试删除列并向左移动，所以脚本运行后，所有包含数据的列都将被整齐地分组在一起。
这是使用联盟和删除列的范围的最佳方法吗？ 任何帮助将不胜感激。
特殊细胞的方法实际上不会在这里很好地为您服务。 相反，find工作表中最后一行数据，只删除列中的单元格，然后将所有内容都移到左侧。 这将比删除整列更快！
Sub Delete_No_Data_Columns() Dim col As Long, lRow as Long Dim h as Long'to store the last columns/header lRow = Range("E" & Rows.Count).End(xlUp).Row ' assumes column E will have last used row ... adjust as needed h = Range("E1").End(xlToRight).Column 'find the last column with the data/header For col = h To 5 Step -1 If Application.CountA(Columns(col)) = 1 Then Range(Cells(2,col),Cells(lRow,col)).Delete shift:=xlToLeft End If Next col Application.ScreenUpdating = False ' i think you want this at the beginning of the program, no? End Sub