How can I use VBA to delete all columns which are empty apart from a specific header?

前端 未结 2 1664
甜味超标
甜味超标 2021-01-27 04:43

I\'d like to delete all columns in a worksheet which meet the following criteria:

  • row 1 = \"foobar\"
  • rows 2-1000 are empty

It sounds simpl

相关标签:
2条回答
  • 2021-01-27 05:06

    How about

    dim col as Long, lastCol as Long, r as range
    lastCol = ActiveSheet.Usedrange.columns(Activesheet.Usedrange.columns.count).column
    for c=lastCol to 1 Step -1
        set r = Range(Cells(1, c), Cells(1000, c))
        if r.Rows(1) = "foobar" Then
            if WorksheetFunction.CountA(Range(r.Rows(2), r.Rows(r.Rows.Count))) = 0 then
                Columns(c).delete
            end if
        end If
    next
    

    [edit by OP: added a missing space]

    0 讨论(0)
  • 2021-01-27 05:11

    Fastest way to delete rows as per your requirement (TRIED AND TESTED).

    I am assuming that Row1 Has Column Headers

    Option Explicit
    
    Sub Sample()
        Dim aCell As Range, rng As Range
        Dim LastCol As Long, LastRow As Long, i As Long
    
        With Sheets("Sheet1")
            Set aCell = .Rows(2).Find(What:="foobar", LookIn:=xlValues, _
            Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
            If Not aCell Is Nothing Then .Rows(2).Delete
    
            LastRow = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByRows, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Row
    
            LastCol = .Cells.Find(What:="*", _
                      After:=.Range("A1"), _
                      Lookat:=xlPart, _
                      LookIn:=xlFormulas, _
                      SearchOrder:=xlByColumns, _
                      SearchDirection:=xlPrevious, _
                      MatchCase:=False).Column
    
            Set rng = Range("A1:" & Split(Cells(, LastCol).Address, "$")(1) _
                      & LastRow)
    
            ActiveSheet.AutoFilterMode = False
    
            For i = 1 To LastCol
                rng.AutoFilter Field:=i, Criteria1:=""
            Next i
    
            rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
            ActiveSheet.AutoFilterMode = False
        End With
    End Sub
    
    0 讨论(0)
提交回复
热议问题