如何编写 VBA 代码来删除工作簿中所有工作表的特定列?
How to write the VBA code to delete specific columns for all worksheets in a workbook?
我正在使用 Excel 2016,我是 VBA 的新手。我需要编写 VBA 代码来删除 Excel 工作簿中所有工作表的特定列。
让我们假设我需要删除的列是所有工作表的 B, D, G, H, AM, AZ
列。
我怎样才能做到这一点?
试试这个:
Sub DeleteCols()
Dim sh As Worksheet
'as mentioned in comments by FunThomas, deleting should be done "backwards", i.e. for right to left
For Each sh In Worksheets
sh.Columns("AZ").Delete
sh.Columns("AM").Delete
sh.Columns("H").Delete
sh.Columns("G").Delete
sh.Columns("D").Delete
sh.Columns("B").Delete
Next
End Sub
或者,您可以使用:
Sub ClearCols()
Dim sh As Worksheet
For Each sh In Worksheets
sh.Columns("B").Clear
sh.Columns("D").Clear
sh.Columns("G").Clear
sh.Columns("H").Clear
sh.Columns("AM").Clear
sh.Columns("AZ").Clear
Next
End Sub
另一种方法是(@Peh 建议):
sh.Range("B:B,D:D,G:H,AM:AM,AZ:AZ").Delete
在许多列上应该更快(您可以类比地使用 Clear
方法)。
通过数组方法并删除 "backwards"
Sub DeleteCols()
Dim sh As Worksheet
Dim arr as Variant
arr = Array("AZ", "AM", "H", "G", "D", "B")
For Each sh In Worksheets
For Each element in arr
sh.Columns(element).Delete
Next
Next
End Sub
我会对以上答案做一些小的调整:
尝试像这样一次性全部删除:
Sub DEL()
Dim SHT As Worksheet
For Each SHT In Worksheets
SHT.Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").EntireColumn.Delete
Next SHT
End Sub
编辑:我看到我的上述建议已经在答案中实现,所以我将添加另一个选项,您可以在没有任何循环的情况下执行此操作(应该是更快的方法):
Sheets.Select 'Selects all sheets at once
Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").Select 'Select all the appropriate columns you want to delete at once
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once
您将看到必须取消的工作表和列的选择。
比较性能:
All-at-once - Total Sheets: 1,001 - Time: 29.137 sec (by JvdV)
One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
这是测试
Option Explicit
Public Sub DeleteColumns()
Dim thisWs As Worksheet, thisCell As Range, t As Double, msg As String
t = Timer
Application.ScreenUpdating = False
Set thisWs = ActiveSheet
Set thisCell = ActiveCell
ThisWorkbook.Worksheets.Select 'Selects all sheets at once
Range("B1, D1, G1:H1, AM1, AZ1").EntireColumn.Select 'All columns on all sheets
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once
Cells(1).Select 'Selects A1 on all sheets
thisWs.Select
thisCell.Activate 'Activates initial range
Application.ScreenUpdating = True
msg = "All-at-once - Total Sheets: " & Format(Sheets.Count, "#,###")
Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
'All-at-once - Total Sheets: 101 - Time: 2.469 sec
'All-at-once - Total Sheets: 501 - Time: 13.484 sec
'All-at-once - Total Sheets: 1,001 - Time: 29.137 sec
End Sub
Sub DeleteCols()
Dim sh As Worksheet, t As Double, msg As String
t = Timer
For Each sh In Worksheets
sh.Columns("AZ").Delete
sh.Columns("AM").Delete
sh.Columns("H").Delete
sh.Columns("G").Delete
sh.Columns("D").Delete
sh.Columns("B").Delete
Next
msg = "One-by-one - Total Sheets: " & Format(Sheets.Count, "#,###")
Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
'One-by-one - Total Sheets: 101 - Time: 3.609 sec
'One-by-one - Total Sheets: 501 - Time: 26.633 sec
'One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
End Sub
Public Sub MakeWS()
Dim i As Long
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets
For i = .Count To 1000
.Item(1).Copy After:=.Item(i)
ActiveSheet.Name = i + 1
Next
End With
Application.ScreenUpdating = True
End Sub
试卷(都一样)
之前
之后
我正在使用 Excel 2016,我是 VBA 的新手。我需要编写 VBA 代码来删除 Excel 工作簿中所有工作表的特定列。
让我们假设我需要删除的列是所有工作表的 B, D, G, H, AM, AZ
列。
我怎样才能做到这一点?
试试这个:
Sub DeleteCols()
Dim sh As Worksheet
'as mentioned in comments by FunThomas, deleting should be done "backwards", i.e. for right to left
For Each sh In Worksheets
sh.Columns("AZ").Delete
sh.Columns("AM").Delete
sh.Columns("H").Delete
sh.Columns("G").Delete
sh.Columns("D").Delete
sh.Columns("B").Delete
Next
End Sub
或者,您可以使用:
Sub ClearCols()
Dim sh As Worksheet
For Each sh In Worksheets
sh.Columns("B").Clear
sh.Columns("D").Clear
sh.Columns("G").Clear
sh.Columns("H").Clear
sh.Columns("AM").Clear
sh.Columns("AZ").Clear
Next
End Sub
另一种方法是(@Peh 建议):
sh.Range("B:B,D:D,G:H,AM:AM,AZ:AZ").Delete
在许多列上应该更快(您可以类比地使用 Clear
方法)。
通过数组方法并删除 "backwards"
Sub DeleteCols()
Dim sh As Worksheet
Dim arr as Variant
arr = Array("AZ", "AM", "H", "G", "D", "B")
For Each sh In Worksheets
For Each element in arr
sh.Columns(element).Delete
Next
Next
End Sub
我会对以上答案做一些小的调整:
尝试像这样一次性全部删除:
Sub DEL()
Dim SHT As Worksheet
For Each SHT In Worksheets
SHT.Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").EntireColumn.Delete
Next SHT
End Sub
编辑:我看到我的上述建议已经在答案中实现,所以我将添加另一个选项,您可以在没有任何循环的情况下执行此操作(应该是更快的方法):
Sheets.Select 'Selects all sheets at once
Range("B:B,D:D,G:G,H:H,AM:AM,AZ:AZ").Select 'Select all the appropriate columns you want to delete at once
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once
您将看到必须取消的工作表和列的选择。
比较性能:
All-at-once - Total Sheets: 1,001 - Time: 29.137 sec (by JvdV)
One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
这是测试
Option Explicit
Public Sub DeleteColumns()
Dim thisWs As Worksheet, thisCell As Range, t As Double, msg As String
t = Timer
Application.ScreenUpdating = False
Set thisWs = ActiveSheet
Set thisCell = ActiveCell
ThisWorkbook.Worksheets.Select 'Selects all sheets at once
Range("B1, D1, G1:H1, AM1, AZ1").EntireColumn.Select 'All columns on all sheets
Selection.Delete Shift:=xlToLeft 'Deletes all columns on all sheets at once
Cells(1).Select 'Selects A1 on all sheets
thisWs.Select
thisCell.Activate 'Activates initial range
Application.ScreenUpdating = True
msg = "All-at-once - Total Sheets: " & Format(Sheets.Count, "#,###")
Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
'All-at-once - Total Sheets: 101 - Time: 2.469 sec
'All-at-once - Total Sheets: 501 - Time: 13.484 sec
'All-at-once - Total Sheets: 1,001 - Time: 29.137 sec
End Sub
Sub DeleteCols()
Dim sh As Worksheet, t As Double, msg As String
t = Timer
For Each sh In Worksheets
sh.Columns("AZ").Delete
sh.Columns("AM").Delete
sh.Columns("H").Delete
sh.Columns("G").Delete
sh.Columns("D").Delete
sh.Columns("B").Delete
Next
msg = "One-by-one - Total Sheets: " & Format(Sheets.Count, "#,###")
Debug.Print msg & " - Time: " & Format(Timer - t, "0.000") & " sec"
'One-by-one - Total Sheets: 101 - Time: 3.609 sec
'One-by-one - Total Sheets: 501 - Time: 26.633 sec
'One-by-one - Total Sheets: 1,001 - Time: 72.164 sec
End Sub
Public Sub MakeWS()
Dim i As Long
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets
For i = .Count To 1000
.Item(1).Copy After:=.Item(i)
ActiveSheet.Name = i + 1
Next
End With
Application.ScreenUpdating = True
End Sub
试卷(都一样)
之前
之后