在VBA中,删除除这些特定列之外的所有列

时间:2016-05-27 12:58:21

标签: excel vba multiple-columns

我的数字与Excel中的列对应: 第4,5,6,7,26,28列。这些列根据工作表动态更改,并取决于上述代码。

如何删除这些列的工作表中的所有列除外?

2 个答案:

答案 0 :(得分:0)

尝试一下:

Sub KolumnKiller()
    Dim s As String, i As Long
    s = ",4,5,6,7,26,28,"
    Application.ScreenUpdating = False
        For i = Columns.Count To 1 Step -1
            If InStr(1, s, "," & i & ",") = 0 Then Cells(1, i).EntireColumn.Delete
        Next i
    Application.ScreenUpdating = True
End Sub

<强> 注意:

如果你知道最右边的列已经是空的话,你可以从 1000 而不是 Columns.Count 开始加快速度。< / p>

答案 1 :(得分:0)

在我的解释中更新了一个愚蠢的错误!

我不想回答问题中没有示例代码的帖子(努力/努力原则),但在这种情况下,您需要考虑的是一个非常重要的方面:您有选择循环遍历每个工作表列并检查它是否在目标列表中或仅仅循环遍历目标列表(显然要快得多)。该决定依赖于一个重要问题:您的列列表已排序?

我知道你的问题按顺序显示了这些列,但我想提一下,以防有可能导致列表混乱,或者其他读者有未排序的列。

Gary的学生给出的答案很有效,他的代码很好地处理了一个无序列表(他是这个网站的经验丰富的贡献者,Instr解决方案让事情变得更好简洁)。

但是,如果您可以确保列表按顺序排列(从最小到最大),或者您已准备好自己对列表进行排序,那么您可以使用更快的解决方案,因为它只允许您遍历目标列表。这也是一个偏好问题,但我喜欢在一个批次中管理行和列删除,纯粹从时间角度来看。因此,下面的代码是您可能会如何做的示例:

    Dim ws As Worksheet
    Dim goers As Range
    Dim keepers As Variant
    Dim v As Variant
    Dim thisCol As Long
    Dim lastCol As Long

    'Your list of columns to keep
    keepers = Array(2, 4, 5, 8, 11, 12, 15)


    Set ws = ThisWorkbook.Worksheets("Sheet1")

    'Initialise goer at column 1 or set to nothing if 1 is a keeper
    Set goers = IIf(keepers(0) = 1, Nothing, ws.Columns(1))

    'Loop through the list extending the column range to next keep column
    lastCol = 1
    For Each v In keepers
        thisCol = v
        If thisCol - lastCol > 1 Then
            Set goers = DelCols(ws, goers, lastCol, thisCol)
        End If
        lastCol = thisCol
    Next

    'Extend to end of worksheet
    Set goers = DelCols(ws, goers, lastCol, ws.Columns.Count)

    'Delete the goers
    goers.Delete


End Sub
Private Function DelCols(ws As Worksheet, cols As Range, col1 As Long, col2 As Long) As Range
    'Helper function to deal with Union
    Dim rng As Range

    'Resize the columns from last+1 to this
    Set rng = ws.Columns(col1 + 1).Resize(, col2 - col1)
    If cols Is Nothing Then
        Set cols = rng
    Else
        Set cols = Union(cols, rng)
    End If

    Set DelCols = cols
End Function