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

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

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

删除所有工作表中除所有列之外的所有列

1 个答案: