Tabele przestawne są jedną z najbardziej użytecznych funkcjonalności Excela a ich rola wraz z dodatkiem Power Pivot jest jeszcze większa. Jednak zdarza się, że tabela prezentuje dane w sposób nieefektywny: dane nie mieszczą się w wyświetlanym oknie, ciężko je ze sobą porównać. Oczywiście istnieją sposoby, aby temu zaradzić. Jednym z nich jest przewijanie suwaków przy oknie, jednakże w poniższym artykule zostanie opisana inna metoda: autodopasowanie szerokości kolumn za pomocą VBA.

Problemy z formatowaniem nagłówków tabeli przestawnej

Przyjrzyjmy się poniższej tabeli z danymi dotyczącymi sprzedaży poszczególnych kategorii produktowych. Dane są nieczytelne, kolumny nie są widoczne, danych nie można ze sobą porównać.

Kolumny możemy oczywiście zwęzić, aby wszystkie zmieściły się w wyświetlanym oknie.

Kolejnym krokiem byłoby formatowanie komórek zawierających nagłówki kolumn tak, aby tekst w komórce się zawijał i wyświetlał w dwóch wierszach.

Jednakże jest to kilkanaście kroków, a istnieje sposób bardziej efektywny i efektowny, który można wykorzystać w przypadku wielu tabel przestawnych.

Makro do ustawiania szerokości kolumn

Wykorzystamy w tym celu Makro oraz poniższy kod:

Sub ShrinkColumnsToReadable()

    Dim oPivot As PivotTable

    Set oPivot = ActiveCell.PivotTable

    Dim oColRange As Range

    Set oColRange = FindColumnLabelsRange(ActiveSheet.Name, oPivot.Name)

    oColRange.Columns.Select

   

    'Increase this number for wider columns, smaller for narrower

    Selection.ColumnWidth = 15

   

    oColRange.Select

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

    End With

   

    'Turn AutoFit Column Width on Update OFF

    oPivot.HasAutoFormat = False

   

End Sub

 

Function FindColumnLabelsRange(sSheet As String, sPivot As String) As Range

    Dim oSheet As Worksheet

    Dim oPivot As PivotTable

   

    Set oSheet = ActiveWorkbook.Sheets(sSheet)

    Set oPivot = oSheet.PivotTables(sPivot)

   

    Set FindColumnLabelsRange = oPivot.ColumnRange

End Function

 

Wystarczy skopiować kod do okna VBA (Alt + F11), które uruchomiane jest przez Developera.

Następnie uruchomimy Makro. Wystarczy spojrzeć na tabelę, żeby zrozumieć jak ono działa. Etykiety wyglądają dużo lepiej, a cała tabela mieści się na wyświetlanym ekranie.

Pobierz plik Excel z kodem VBA

Więcej szczegółów jest dostępnych w pliku Nagłówki VBA.xlsm.