Question

我正在尝试从多个工作表中删除多个列，同时保留列表中的列。

例如，我有sheet1，sheet2，sheet3，...，sheet7。从这些表格中我可以保留特定的列。

从sheet1我希望保留s.no，cust.name，product，date等列，这些列应该从sheet2我删除想要保留prod.disc,address，pin剩下的所有内容应该被删除，就像我有剩余的工作表一样，我想保留特定列剩下的全部应该被删除。我试图使用数组，但无法启动如何做。我有基本的语法。

Sub sbVBS_To_Delete_Specific_Multiple_Columns()
Sheets("Sheet1").Range("A:A,C:C,H:H,K:O,Q:U").EntireColumn.Delete
End Sub`[code]

但是这对我不起作用，因为将来某些列可能会添加，我希望列应该识别哪个列要保留并保留丢弃。

Answer 1

好的，这是基本代码。在主过程中指定要删除的工作表和列。设置要在子过程中查找标题的行。

Sub DeleteColumns()
    ' 17 Mar 2017

    Dim ClmCaption As Variant
    Dim Ws As Worksheet
    Dim i As Integer

    Set Ws = ActiveSheet
    ' better to specify the sheet by name, like Set Ws = ThisWorkbook.Worksheets("My Excel")

    Application.ScreenUpdating = False      ' freeze screen (speeds up execution)
    ClmCaption = Array("One", "two", "three", "four", "five")
    ' specify all the columns you want to delete by caption , not case sensitive

    For i = 0 To UBound(ClmCaption)         ' loop through all the captions
        DelColumn Ws, CStr(ClmCaption(i))   ' call the sub for each caption
    Next i
    Application.ScreenUpdating = True       ' update screen
End Sub

Private Sub DelColumn(Ws As Worksheet, Cap As String)
    ' 17 Mar 2017

    Dim CapRow As Long
    Dim Fnd As Range

    CapRow = 3                              ' this is the row where the captions are
    Set Fnd = Ws.Rows(CapRow).Find(Cap)     ' find the caption
    If Fnd Is Nothing Then
        MsgBox "The caption """ & Cap & """ doesn't exist." & vbCr & _
               "The column wasn't deleted.", _
               vbInformation, "Invalid parameter"
    Else
        Ws.Columns(Fnd.Column).EntireColumn.Delete Shift:=xlToLeft
    End If
End Sub

您可以按原样运行代码，但是会收到很多错误消息，因为指定的字幕不存在。

Answer 2

以下内容使用Scripting Dictionary对象维护要作为字典键处理的工作表列表，其中列标题标签数组将作为关联的项目保留

Option Explicit

Sub delColumnsNotInDictionary()
    Dim d As Long, ky As Variant, dict As Object
    Dim c As Long, lc As Long

    Set dict = CreateObject("Scripting.Dictionary")
    dict.comparemode = vbTextCompare

    dict.Item("Sheet1") = Array("s.no", "cust.name", "product", "date")
    dict.Item("Sheet2") = Array("prod.disc", "address", "pin")
    dict.Item("Sheet50") = Array("foo", "bar")

    With ThisWorkbook
        For Each ky In dict.keys
            With Worksheets(ky)
                lc = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                                 SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                                 MatchCase:=False, SearchFormat:=False).Column
                For c = lc To 1 Step -1
                    'filter array method of 'not found in array'
                    'WARNING! CASE SENSITIVE SEARCH  - foo <> FOO
                    If UBound(Filter(dict.Item(ky), .Cells(1, c).Value2)) = -1 Then
                        '.Cells(1, c).EntireColumn.Delete
                    Else
                        Debug.Print .Cells(1, c).Value2 & " at " & _
                          UBound(Filter(dict.Item(ky), .Cells(1, c).Value2))
                    End If
                    'worksheet MATCH method of 'not found in array'
                    'Case insensitive search - foo == FOO
                    If IsError(Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)) Then
                        .Cells(1, c).EntireColumn.Delete
                    Else
                        Debug.Print .Cells(1, c).Value2 & " at " & _
                          Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)
                    End If
                Next c
            End With
        Next ky
    End With

    dict.RemoveAll: Set dict = Nothing

End Sub

请注意，我已经提供了两种方法来确定列标题标签是否在要保留的列数组中。一个是区分大小写的（数组Filter方法）而另一个不是（工作表函数MATCH方法）。不区分大小写的搜索方法目前处于活动状态。

从多个工作表中删除多个列

2 个答案: