简体   繁体   中英

deleting blank columns to create pivot table using excel-vba

I'm trying to automate the generation of a pivot table for a report I have to write at work. When I import data into excel the data has these extra columns with no information in them. As you probably know, Excel will not create pivot tables when there are extra columsn. Is there a script that can delete the columns that have no data?

A VBA solution is preferable.

有多余列的有损数据的图像

Try this ( TRIED AND TESTED )

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

I would recommend Adam's way (It is more efficient) for preparing the data for Pivot as per your requirements. My code will fail if there is a blank cell which has a space. You might want to use

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

in lieu of

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

in Adam's code.

If you are sure that there will be no blank space then you can use my code as well :)

Sid

This should be more efficient than @Siddharth's answer because it only checks the first row. (But he beat me by many minutes, so +1 to him!)
Since we know that when there is no column heading, Excel will not allow a pivot table to be created.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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