如何編寫VBA代碼以刪除工作簿中所有工作表的特定列？

Question

我正在使用Excel 2016，並且是VBA的新手。 我需要編寫VBA代碼以刪除Excel工作簿中所有工作表的特定列。

讓我們假設我需要刪除的列是所有工作表的B, D, G, H, AM, AZ 。

我該如何實現？

Answer 1

嘗試這個：

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方法）。

Answer 2

通過數組處理並刪除“向后”

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

Answer 3

我將對上述答案進行一些小的調整：

嘗試像這樣一次刪除所有內容：

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

您將需要選擇要取消的工作表和列。

Answer 4

比較性能：

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

---

測試紙（都一樣）

之前

后