Question

我在我的表格中导入Excel中的数据修复了95列我想在Excel中粘贴数据时创建宏或代码如果整列完全空白则应该删除。

Answer 1

你可以试试这个：

Sub Main
    Dim iCol As Long

    With Worksheets("mySheetName").UsedRange '<--| change "mySheetName" to your actual sheet name
        For iCol = .Columns.Count to 1 Step - 1
            If WorksheetFunction.CountA(.Columns(iCol)) = 1 Then .Columns(iCol).EntireColumn.Delete
        Next
    End With
End Sub

Answer 2

Dim r As Range, rows As Long, i As Long
Set r = ActiveSheet.Range(Cells(1, 1), Cells(lastrow, lastcolumn))
rows = r.rows.Count
For i = rows To 1 Step (-1)
If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete
Next

Answer 3

要将范围扩展到第 1 列：

选项 1

Sub TLD_Delete_Empty_Columns_OptionA(Optional sh As Worksheet)
    Dim i As Integer, rngData As Range

    If sh Is Nothing Then Set sh = ActiveSheet

    'Determinate used range
    With sh
        Set rngDatos = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count + .UsedRange.Column - 1))
    End With
    
    'With new range, loop through all columns searching values and delete column if dont find its
    With rngData
        For i = .Columns.Count To .Column Step -1
            If WorksheetFunction.CountA(.Columns(i)) = 0 Then .Columns(i).EntireColumn.Delete
        Next
    End With

End Sub

带有特殊单元格的选项 2：

Sub TLD_Delete_Empty_Columns_OptionB(Optional sh As Worksheet)
    Dim i As Integer, rngData As Range, lRows As Long, lBlanks As Long

    If sh Is Nothing Then Set sh = ActiveSheet

    'Determinate used range
    With sh
        Set rngDatos = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count + .UsedRange.Column - 1))
    End With

    With rngData
        lRows = .Rows.Count
    
        For i = .Columns.Count To .Column Step -1
            lBlanks = 0

            On Error Resume Next
            With Columns(i)
                'Use one variable.
                lBlanks = .SpecialCells(xlCellTypeBlanks).Rows.Count
                
                If lRows = lBlanks Then .EntireColumn.Delete 
            End With
            On Error GoTo 0
        Next
    End With
End Sub

注意：如果在一个 IF 的逻辑比较中直接使用 '.SpecialCells(xlCellTypeBlanks).Rows.Count'，则 'resume next' 会强制执行有条件的结构内容。

带有参数的选项 3 用于出于任何原因排除一个或多个列：

Sub TLD_Delete_Empty_Columns_OptionC(Optional sh As Worksheet, Optional aExcept As Variant=Empty)
    Dim i As Integer, rngData As Range, bDelete As Boolean

    If sh Is Nothing Then Set sh = ActiveSheet
    If IsNumeric(aExcept) Then aExcept = Array(aExcept)

    With sh
        Set rngData = .Range(.Cells(1, 1), .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count + .UsedRange.Column - 1))
    End With
    
    With rngData
        For i = .Columns.Count To .Column Step -1
            bDelete = True
            If IsEmpty(aExcept) Then GoSub ForDeleting
            If WorksheetFunction.CountA(.Columns(i)) = 0 And bDelete Then .Columns(i).EntireColumn.Delete
        Next
    End With
Exit Sub

ForDeleting:
    Dim iCol As Variant
    
    For Each iCol In aExcept

        If i = iCol Then
            bDelete = False
            Exit For
        End If
    Next
    
    Return
End Sub

如何删除空白列VBA

3 个答案: