简体   繁体   English

Excel VBA 应用于选定列并删除该工作表中的所有其他列

[英]Excel VBA applied to selected columns and delete all the other columns in that worksheet

I have two columns C and DK and code to select them我有两列CDK和代码到 select 它们

Application.Union(Range("C1"), Range("DK1")).EntireColumn.Select

I want to work in the same worksheet say "Dashboard" not to create a new one and delete all the other (not selected) columns in that sheet.我想在同一个工作表中工作说"Dashboard"不要创建一个新的并删除该工作表中的所有其他(未选择)列。

Solution解决方案

Sub DeleteAllOtherColumns()

    Dim myColumns  As Range
    Dim delColumns As Range
    Dim headerRow  As Range
    Dim headerCell As Range
    Dim Ws         As Worksheet
    
    Set Ws = Worksheets("Dashboard")
    Set myColumns = Ws.Range("C1,DK1")
    Set headerRow = Ws.Range(Cells(1, 1), Cells(1, GetLastColumn(Ws)))
    
    For Each headerCell In headerRow.Cells
        If Application.Intersect(headerCell, myColumns) Is Nothing Then
            Set delColumns = RngUnion(delColumns, headerCell)
        End If
    Next
    
    If Not delColumns Is Nothing Then
        delColumns.EntireColumn.Delete
    End If
    
    MsgBox "Done!"
End Sub

Private Function GetLastColumn(Optional TargetSheet As Worksheet) As Long
    If TargetSheet Is Nothing Then Set TargetSheet = ActiveSheet
    On Error Resume Next
    With TargetSheet
        GetLastColumn = .Cells.Find( _
            what:="*", _
            After:=.Range("A1"), _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column
    End With
    If GetLastColumn = 0 Then GetLastColumn = 1
End Function

Private Function RngUnion(Rng1 As Range, Rng2 As Range) As Range
    If Rng2 Is Nothing Then Err.Raise 91 ' Object variable not set
    If Rng1 Is Nothing Then
        Set RngUnion = Rng2
        Exit Function
    End If
    Set RngUnion = Union(Rng1, Rng2)
End Function

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM