保留表格的特定列 - 刪除所有其他列表

Question

我的代碼如下運行良好，但不知何故需要很長時間才能完成這麼小的操作。而且還做得比我需要的多。我正在尋求一些幫助來改進它。

我只需要保持列「NAMEA」「nameB和板材‘incidents_data’的‘nameC’刪除所有其他列

我想也得到這個單方面的坐：。'刪除，如果電池不含有「×」。不需要它。

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

    For currentColumn = Worksheets("Incidents_data").UsedRange.Columns.Count To 1 Step -1 

     columnHeading = Worksheets("Incidents_data").UsedRange.Cells(1, currentColumn).Value 

     'CHECK WHETHER TO KEEP THE COLUMN 
     Select Case columnHeading 
      Case "nameA", "nameB", "nameC" 
       'Do nothing 
      Case Else 
       'Delete if the cell doesn't contain "x" 
       If InStr(1, _ 
        Worksheets("Incidents_data").UsedRange.Cells(1, currentColumn).Value, _ 
        "DLP", vbBinaryCompare) = 0 Then 

        Worksheets("Incidents_data").Columns(currentColumn).Delete 

       End If 
     End Select 
    Next 

End Sub 

Answer 1

Sub keep_specific_columns() 
    Dim currentColumn As Integer, _ 
     columnHeading As String, _ 
     ColzToDelete As String, _ 
     CounT As Integer, _ 
     Ws As Worksheet 

Set Ws = Worksheets("Incidents_data") 

With Ws 
    For currentColumn = .UsedRange.Columns.CounT To 1 Step -1 
     columnHeading = .Cells(1, currentColumn).Value 
     'CHECK WHETHER TO KEEP THE COLUMN 
     Select Case columnHeading 
      Case "nameA", "nameB", "nameC" 
       'Do nothing 
      Case Else 
       'Delete store the columns to delete them at the end 
       ColzToDelete = ColzToDelete & "," & _ 
           Col_Letter(currentColumn) & ":" & Col_Letter(currentColumn) 
       CounT = CounT + 1 
     End Select 
     If CounT <> 10 Then 
     Else 
      'Delete when you have 10 columns 
      .Range(Right(ColzToDelete, Len(ColzToDelete) - 1)).Delete Shift:=xlToLeft 
      ColzToDelete = vbNullString 
      CounT = 0 
     End If 
    Next currentColumn 
    If ColzToDelete <> vbNullString Then .Range(Right(ColzToDelete, Len(ColzToDelete) - 1)).Delete Shift:=xlToLeft 
End With 

End Sub 
Function Col_Letter(lngCol As Long) As String 
    Col_Letter = Split(Cells(1, lngCol).Address(True, False), "$")(0) 
End Function