удаление пустых столбцов для создания сводной таблицы с помощью Excel-VBA

Question

Я пытаюсь автоматизировать создание сводной таблицы для отчета, который я должен написать на работе. Когда я импортирую данные в Excel, в этих данных появляются лишние столбцы без информации. Как вы, вероятно, знаете, Excel не будет создавать сводные таблицы при наличии дополнительных столбцов. Есть ли скрипт, который может удалить столбцы, которые не имеют данных?

Решение VBA является предпочтительным.

Answer 1

Попробуйте это ( ПРОВЕРЕНО И ИСПЫТАНО )

Sub Sample()
    Dim LastCol As Long
    Dim i As Long

    LastCol = Sheets("Sheet1").Cells.Find(What:="*", _
              After:=Sheets("Sheet1").Range("A1"), _
              Lookat:=xlPart, _
              LookIn:=xlFormulas, _
              SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious, _
              MatchCase:=False).Column

    For i = LastCol To 1 Step -1
        If Application.WorksheetFunction.CountA(Sheets("Sheet1").Columns(i)) = 0 Then _
        Sheets("Sheet1").Columns(i).Delete
    Next i
End Sub

Followup

Я бы рекомендовал способ Адама (это более эффективно) для подготовки данных для Pivot в соответствии с вашими требованиями. Мой код не удастся, если есть пустая ячейка с пробелом. Возможно, вы захотите использовать

Len(Trim(ws.Cells(start_row, col).Value)) = 0

вместо

ws.Cells(start_row, col).Value = ""

в коде Адама.

Если вы уверены, что не будет пробела, вы также можете использовать мой код:)

Sid

Answer 2

Это должно быть более эффективно, чем ответ @ Сиддхарта, потому что он проверяет только первый ряд.(Но он избил меня на много минут, поэтому ему +1!)
Поскольку мы знаем, что когда заголовок столбца отсутствует, Excel не разрешит создание сводной таблицы.

Option Explicit

Sub prepare_for_pivot()
    Dim ws As Worksheet
    Dim last_col As Long
    Dim start_row As Long
    Dim col As Long
    Set ws = ThisWorkbook.Sheets(1)

    start_row = 1
    last_col = ws.Cells(start_row, ws.Columns.Count).End(xlToLeft).Column

    For col = last_col To 1 Step -1
        If ws.Cells(start_row, col).Value = "" Then
            ws.Columns(col).EntireColumn.Delete
        End If
    Next col
End Sub