删除带有空白标题的列 VBA

Question

我正在寻求帮助，以删除我的数据范围内具有空白标题的两列。这些空白标题将出现在我使用的范围的第一行。解决此问题的最佳方法是什么？我应该使用 .Find 搜索第一行中的空白单元格，然后获取两个空白单元格的列地址以将其删除吗？

目前，我只是删除了我知道它们会出现的列，但这有可能会改变。当前代码：

rngUsed.Columns("F").Delete
rngUsed.Columns("H").Delete

由于数据可能会发生变化，那么更好的处理方法是什么？

谢谢！

Answer 1

删除带有空白标题的列

• 当前设置位于Test Mode 中，即它将选择要删除的列。如果结果令人满意，请在删除列时切换到Const TestMode As Boolean = False。
• 调整常量部分的值。

守则

Option Explicit

Sub TESTdeleteBlankHeadered()
    
    Const wsName As String = "Sheet1"
    Const ColumnsCount As Long = 2 ' -1 - all columns containing blank headers.
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim rg As Range: Set rg = wb.Worksheets(wsName).UsedRange
    
    deleteBlankHeadered rg, ColumnsCount ' first found columns
    'deleteBlankHeadered rg, ColumnsCount, True ' last found columns
    'deleteBlankHeadered rg ' all found columns

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      In a worksheet, deletes a specified number of its columns,
'               defined by blank cells in the first (header) row of
'               a given range.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub deleteBlankHeadered( _
        rg As Range, _
        Optional ByVal ColumnsCount As Long = -1, _
        Optional ByVal LastOccurringColumns As Boolean = False)
        
    ' When 'True', tests with select.
    ' When 'False', deletes.
    Const TestMode As Boolean = True
        
    ' Validate inputs.
    If rg Is Nothing Then Exit Sub
    If ColumnsCount < -1 Or ColumnsCount = 0 Then Exit Sub
    
    ' Define Source Row Range.
    Dim srg As Range: Set srg = rg.Areas(1).Rows(1)
    
    ' Write values from Source Row Range to Data Array.
    Dim cCount As Long: cCount = srg.Columns.Count
    Dim Data As Variant
    If cCount > 1 Then
        Data = srg.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = srg.Value
    End If
    
    ' Define 'elements' of the 'For...Next' Loop.
    Dim cFirst As Long, cLast As Long, cStep As Long
    If LastOccurringColumns Then
        cFirst = cCount: cLast = 1: cStep = -1
    Else
        cFirst = 1: cLast = cCount: cStep = 1
    End If
    
    ' Declare additional variables.
    Dim drg As Range ' Delete Range
    Dim oCount As Long ' Occurrences Count
    Dim j As Long ' Data Array (Source Row Range) Columns Counter
    
    ' Loop through columns of Data Array and use found blank values
    ' to combine blank cells with Delete Range.
    For j = cFirst To cLast Step cStep
        If Not IsError(Data(1, j)) Then
            If Len(Data(1, j)) = 0 Then
                oCount = oCount + 1
                Select Case oCount
                    Case 1
                        Set drg = srg.Cells(j)
                        If ColumnsCount = 1 Then
                            Exit For
                        End If
                    Case ColumnsCount
                        Set drg = Union(drg, srg.Cells(j))
                        Exit For
                    Case Else
                        Set drg = Union(drg, srg.Cells(j))
                End Select
            End If
        End If
    Next
    
    ' Declare additional variables.
    Dim ActionTaken As Boolean
    
    ' Delete Column Ranges (containing blank headers).
    If Not drg Is Nothing Then
        Application.ScreenUpdating = False
        If TestMode Then
            drg.Worksheet.Activate
            drg.EntireColumn.Select
        Else
            drg.EntireColumn.Delete
        End If
        Application.ScreenUpdating = True
        ActionTaken = True
    End If
    
    ' Inform user.
    If ActionTaken Then
        MsgBox "Columns deleted: " & oCount, vbInformation, "Success"
    Else
        MsgBox "No columns deleted.", vbExclamation, "No Action Taken"
    End If

End Sub

Answer 2

您可以使用SpecialCells 查找第一行的空白并删除相应的列：

Dim rng As Range

Set rng = Range("B3").CurrentRegion 'for example...

On Error Resume Next 'ignore error if no blanks
rng.Rows(1).SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
On Error GoTo 0 'stop ignoring errors