简体   繁体   English

如何删除空白列VBA

[英]How to delete blank columns VBA

I am importing data in Excel in my table is fix with 95 columns I want to create a macro or code whenever I will paste data in Excel if entire column is completely blank then it should be delete.我在 Excel 中导入数据在我的表中修复了 95 列我想创建一个宏或代码,每当我将数据粘贴到 Excel 时,如果整列完全空白,那么应该删除它。

在此处输入图片说明

You could try this:你可以试试这个:

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
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

To extend the range to column 1:要将范围扩展到第 1 列:

Option 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

Option 2 with SpecialCells:带有 SpecialCells 的选项 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

Note: If you use '.SpecialCells(xlCellTypeBlanks).Rows.Count' directly in logic comparison of one IF, 'resume next' forces execution of content of structure conditional.注意:如果在一个 IF 的逻辑比较中直接使用 '.SpecialCells(xlCellTypeBlanks).Rows.Count',则 'resume next' 会强制执行有条件的结构内容。

Option 3 with parameter for excluding one o more columns for any reason:选项 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

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

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