Excel 删除所有工作表中的所有列（命名列除外）

我想删除Excel工作簿所有工作表中的所有列，但以下列除外：

Date
Name
Amount Owing
Balance

以下代码正在活动工作表中工作：

Sub DeleteSelectedColumns()
Dim currentColumn As Integer
Dim columnHeading As String

For currentColumn = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
    columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value

'Check whether to preserve the column
    Select Case columnHeading
    'Insert name of columns to preserve
        Case "Date", "Name", "Amount Owing", "Balance"
            'Do nothing
        Case Else
            'Delete the column
            ActiveSheet.Columns(currentColumn).Delete
        End Select
    Next
End Sub

---

如何修改此代码以应用于所有工作表？

类似的内容正是您需要的：

Sub DeleteSelectedColumns()

    Dim ws As Worksheet
    Dim rDel As Range
    Dim HeaderCell As Range
    Dim sKeepHeaders As String
    Dim sDelimiter as String

    sDelmiter = ":"
    sKeepHeaders = Join(Array("Date", "Name", "Amount Owing", "Balance"), sDelimiter)

    For Each ws In ActiveWorkbook.Sheets
        Set rDel = Nothing
        For Each HeaderCell In ws.Range("A1", ws.Cells(1, ws.Columns.Count).End(xlToLeft)).Cells
            If InStr(1, sDelimiter & sKeepHeaders & sDelimiter, sDelimiter & HeaderCell.Value & sDelimiter, vbTextCompare) = 0 Then
                If Not rDel Is Nothing Then Set rDel = Union(rDel, HeaderCell) Else Set rDel = HeaderCell
            End If
        Next HeaderCell
        If Not rDel Is Nothing Then rDel.EntireColumn.Delete
    Next ws

End Sub

---

您需要了解包含逗号的sheet name如何？@JohnyL我强烈建议sheet name不包含逗号，您可以将分隔符更改为冒号

：

，因为工作表名称不能包含冒号。我想应该在您的答案中注明，或者将分隔符更改为冒号。@JohnyL还应该指出，即使工作表名称包含逗号，代码也会成功运行。在计算标题单元格值时，它不会查看sheetnames。如果仍然可以成功运行，我没有坚持认为它不会工作-我只是问它是否会工作。：）