excel - 删除所有工作表中的所有列，命名的列除外

Question

我想删除 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

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

标签： excelvba

Answer 1

你正在寻找这样的东西：

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