使用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