保留工作表的特定列 - 删除所有其他列

时间:2015-11-17 14:27:58

标签: excel vba excel-vba

我的下面的代码效果很好但不知何故需要很长时间才能完成这么小的操作。并且还做得比我需要的更多。我正在寻求一些帮助以改善它。

我只需要保留列" nameA" " nameB和" nameC" sheet" incidents_data"。删除所有其他列。

我也希望能够获得这个参与者:'如果单元格不包含" x"则删除。不需要它。

'date_from'

1 个答案:

答案 0 :(得分:0)

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