Question

我有一个数据电子表格，其中包含120列数据的最佳部分，但我并不是全部，所以对于文件大小，我删除了我不需要的数据。我认为这可以是自动化的，并且基于我在网上找到的脚本汇总了VB函数，该脚本根据值列表检查列标题，如果该值在列表中，则删除列。

由于电子表格中的列数因更新而发生变化，而不是修复代码中的列引用，我将一个开始和结束列输入到VB代码读取的两个单元格中但由于某种原因，我在出现错误时收到错误我选择了确切的列数。如果我选择较小的列数（即：表格是列D：K而我选择D：F），代码运行正常，列将被删除。任何人都可以解释代码在哪里，因为我是VB的新手。

非常感谢。

以下是我正在使用的代码，如果我可以弄清楚如何上传示例文件，我也会这样做：

Sub DeleteSpecifcColumn()

    Dim rngFound As Range, rngToDelete As Range
    Dim strFirstAddress, fstCol, LstCol As String
    Dim varList As Variant
    Dim lngCounter As Long

    fstCol = ActiveSheet.Range("B2").Value
    LstCol = ActiveSheet.Range("B3").Value

    Application.ScreenUpdating = False

    'varList = Range("Sheet1!B3:B8").Value
    varList = ActiveSheet.ListObjects("Delete").ListColumns(1).DataBodyRange

    For lngCounter = LBound(varList) To UBound(varList)

        'Fixed column range
        'With ActiveSheet.Range("E:F")

        'Using table headings
        'With ActiveSheet.ListObjects("Content").HeaderRowRange

        'Cell values on sheet to build column range and then search against list
        With ActiveSheet.Range(vbDblQuote & fstCol & ":" & LstCol & vbDblQuote)
        Set rngFound = .Find( _
                                What:=varList(lngCounter, 1), _
                                Lookat:=xlWhole, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True _
                                    )

            If Not rngFound Is Nothing Then
                If rngToDelete Is Nothing Then
                    Set rngToDelete = rngFound
                Else
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                End If

                strFirstAddress = rngFound.Address
                Set rngFound = .FindNext(After:=rngFound)

                Do Until rngFound.Address = strFirstAddress
                    Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    Set rngFound = .FindNext(After:=rngFound)
                Loop
            End If
        End With
    Next lngCounter

    If Not rngToDelete Is Nothing Then rngToDelete.EntireColumn.Delete

    Application.ScreenUpdating = True

End Sub

Answer 1

这样的事情会起作用吗？假设你的所有标题都在第一行。

Sub DeleteHeadings()
  Dim headingsToDelete() As Variant: headingsToDelete = Array("a", "b", "c")
  Dim deletedOffset As Integer: deletedOffset = 0

  For Column = 1 To ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
    If (IsInArray(ActiveSheet.Cells(1, Column).Value, headingsToDelete)) Then
      ActiveSheet.Columns(Column - deletedOffset).Delete
      deletedOffset = deletedOffset + 1
    End If
  Next
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

IsInArray功能： How to find if an array contains a string

上一期专栏：http://www.globaliconnect.com/excel/index.php?Itemid=475&catid=79&id=86:last-used-row-last-used-column-vba&option=com_content&view=article

Answer 2

如果标题只出现一次，您可以使用：

Public Sub DeleteSpecificColumn()

    Dim rngFound As Range, rngToDelete As Range
    Dim rDeleteValue As Range
    Dim fstCol As Long, lstCol As Long

    With ThisWorkbook.Worksheets("Sheet1") 'We're working with the workbook containing the code in "Sheet1".
        For Each rDeleteValue In .ListObjects("Delete").ListColumns(1).DataBodyRange
            With .Range("D1", .Cells(1, .Columns.Count).End(xlToLeft)) 'References D1 to last cell in row 1 containing data.
                Set rngFound = .Find( _
                    What:=CStr(rDeleteValue), _
                    Lookat:=xlWhole, SearchOrder:=xlByColumns, _
                    SearchDirection:=xlNext, _
                    MatchCase:=True)
                If Not rngFound Is Nothing Then
                    If rngToDelete Is Nothing Then
                        Set rngToDelete = rngFound
                    Else
                        Set rngToDelete = Application.Union(rngToDelete, rngFound)
                    End If
                End If
                Set rngFound = Nothing
            End With
        Next rDeleteValue
    End With

    If Not rngToDelete Is Nothing Then rngToDelete.EntireColumn.Delete

End Sub

如果标题出现多次，您可以使用：

Public Sub DeleteSpecificColumn()

    Dim rngFound As Range, rngToDelete As Range
    Dim rDeleteValue As Range
    Dim fstCol As Long, lstCol As Long
    Dim sFirstAddress As String

    With ThisWorkbook.Worksheets("Sheet1") 'We're working with the workbook containing the code in "Sheet1".
        For Each rDeleteValue In .ListObjects("Delete").ListColumns(1).DataBodyRange
            With .Range("D1", .Cells(1, .Columns.Count).End(xlToLeft)) 'References D1 to last cell in row 1 containing data.
                Set rngFound = .Find( _
                    What:=CStr(rDeleteValue), _
                    Lookat:=xlWhole, SearchOrder:=xlByColumns, _
                    SearchDirection:=xlNext, _
                    MatchCase:=True)

                If Not rngFound Is Nothing Then
                    sFirstAddress = rngFound.Address

                    Do
                        If rngToDelete Is Nothing Then
                            Set rngToDelete = rngFound
                        Else
                            Set rngToDelete = Application.Union(rngToDelete, rngFound)
                        End If

                        Set rngFound = .FindNext(rngFound)
                    Loop While rngFound.Address <> sFirstAddress
                End If
                Set rngFound = Nothing
            End With
        Next rDeleteValue
    End With

    If Not rngToDelete Is Nothing Then rngToDelete.EntireColumn.Delete

End Sub

两组代码都从D1开始，并在包含数据（或公式）的最后一列结束。代码.Cells(1, .Columns.Count).End(xlToLeft)与转到单元格XFD1并按Ctrl+Left相同。

根据列表中的标题名称删除Excel表列

2 个答案: