wimgielis.com

Van ruwe data naar analyse

• 10/09/2021

Inleiding

Het is weer een tijdje geleden dat er een nieuw artikel op de site verscheen, maar vandaag is het zover. Wat ik letterlijk elke dag doe, is data aansluiten/analyseren/enz. Het gaat dan vaak om een dump of export van ruwe data in Excel waarop ik wil filteren, sorteren of andere bewerkingen toepassen. Wat telkens weer terug komt, is dezelfde set van stappen:

• de data plakken in Excel
• een titelrij voorzien
• de autofilter toepassen
• kolombreedtes passend instellen
• titelblokkering toepassen
• eventueel een draaitabel toevoegen
• enz.

Dit deed ik steeds manueel, tot nu ! Ik heb een macro geschreven die bovenstaande stappen automatiseert (behalve stap 1 al zou ik dat ook wel kunnen doen). We plakken de data:

en de macro vormt het om tot dit:

De code

Sub Prepare_Range_For_Analysis()

    Dim r                     As Range
    Dim tbl                   As ListObject
    Dim rngToEvaluate         As Range
    Dim rngTitleRow           As Range
    Dim wsActiveSheet         As Worksheet
    Dim i                     As Long
    Dim sAdd_Header           As String
    Dim bAdd_Header           As Boolean

    Set wsActiveSheet = ActiveSheet

    If TypeName(Selection) <> "Range" Then
        MsgBox "Selecteer eerst een cel in het bereik."
        GoTo einde
    End If

    Set r = Selection

    Application.ScreenUpdating = False

    Set tbl = r.ListObject
    If Not tbl Is Nothing Then

        MsgBox "Echte Excel tabellen hebben minder voordeel bij deze macro.", vbInformation
        Exit Sub

    End If

    Set rngToEvaluate = Nothing
    On Error Resume Next
    Set rngToEvaluate = wsActiveSheet.AutoFilter.Range
    On Error GoTo 0

    If rngToEvaluate Is Nothing Then

        'there is no Autofilter in the active sheet
        Set rngToEvaluate = r.CurrentRegion

    Else

        MsgBox "Graag de autofilter uitschakelen.", vbInformation
        Exit Sub

    End If

    On Error Resume Next
    sAdd_Header = LCase(Left(Application.Trim(InputBox("Wilt u een titelrij toevoegen ?", "Header row", "Y")), 1))
    On Error GoTo 0

    If Trim(sAdd_Header) = "" Then
        MsgBox "Please enter a choice.", vbInformation
        Exit Sub
    End If

    bAdd_Header = (sAdd_Header = "y")
    If bAdd_Header Then

        If rngToEvaluate.Row = 1 Then
            wsActiveSheet.Rows(rngToEvaluate.Row).Insert
        End If

        Set rngTitleRow = rngToEvaluate.Rows(1).Offset(-1)
        For i = 1 To rngTitleRow.Cells.count
            If WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Actual") > 0 Or _
               WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Budget") > 0 Then

                rngTitleRow.Cells(1, i).value = "Scenario"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "FIN") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "WRK") > 0 Then

                rngTitleRow.Cells(1, i).value = "Versie"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "EUR") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "USD") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GBP") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "PLN") > 0 Then

                rngTitleRow.Cells(1, i).value = "Munt"

            ElseIf WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "LC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "LOC") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "GRP") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Local Currency") > 0 Or _
                   WorksheetFunction.CountIf(rngToEvaluate.Columns(i), "Group Currency") > 0 Then

                rngTitleRow.Cells(1, i).value = "Munt_Type"

            ElseIf WorksheetFunction.Min(rngToEvaluate.Columns(i)) = 1950 And _
                   WorksheetFunction.max(rngToEvaluate.Columns(i)) = 2050 Then

                rngTitleRow.Cells(1, i).value = "Jaar"

            ElseIf WorksheetFunction.Min(rngToEvaluate.Columns(i)) >= 1 And _
                   WorksheetFunction.max(rngToEvaluate.Columns(i)) <= 12 Then

                rngTitleRow.Cells(1, i).value = "Maand"

            Else
                rngTitleRow.Cells(1, i).value = Split(wsActiveSheet.Cells(, i).Address, "$")(1)
            End If
        Next
    Else
        Set rngTitleRow = rngToEvaluate.Rows(1)
    End If

    'rngTitleRow.Font.Bold = True

    On Error Resume Next
    rngTitleRow.Style = "Kop 2"
    rngTitleRow.Style = "Heading 2"
    On Error GoTo 0
    rngTitleRow.HorizontalAlignment = xlCenter

    With ActiveWindow
        .SplitColumn = rngTitleRow.Column - .ScrollColumn + 1
        .SplitRow = rngTitleRow.Row - .ScrollRow + 1
        .FreezePanes = True
    End With

    rngTitleRow.AutoFilter

    'column widths, with a given max width
    rngToEvaluate.EntireColumn.AutoFit
    For i = 1 To rngTitleRow.Cells.count
        rngToEvaluate.Columns(i).ColumnWidth = Application.Min(50, rngToEvaluate.Columns(i).ColumnWidth)
    Next

    Application.Goto rngTitleRow.Cells(1), True

    If MsgBox("Would you like to create a pivot table based on it ?", vbYesNo) = vbYes Then
        RangeToPivot control
    End If

einde:
    Application.ScreenUpdating = True

End Sub

De code vraagt of er een rij met titels moet ingevoegd worden. Als de data reeds op rij 1 begint, zal een nieuwe rij ingevoegd worden. Zoniet dan maakt de code de titels aan in de cellen boven de tabel. Als er dan inderdaad een titelrij moet komen, dan wordt die opgevuld met letters: A voor de eerste kolom in de data, B voor de tweede kolom, enz. Het is toegestaan dat de gegevens pas beginnen in cel D20, ik zeg maar wat. Titelblokkering wordt ook toegepast, en de kolommen worden op hun maximale breedte gezet (maar niet breder dan 50 pixels).

Wat voor mij ook belangrijk is, is dat bepaalde kolommen herkend worden. Zo spreek ik in mijn dagdagelijkse job over scenario's, versies, jaren, maanden, munten, munttypes, klanten, producten, rekeningen, kostenplaatsen, ... Wie weet kan je iets soortgelijks ook gebruiken. Tot slot vraagt de code ook of er een draaitabel van de data gemaakt moet worden (opnieuw met tijdsbesparende opties). Die specifieke macro heb ik voor mezelf geschreven en hebben jullie niet, maar je kan hier gerust inspiratie uit halen.

Hopelijk besparen jullie ook de nodige tijd met deze nuttige macro !

• « Vorig Excel artikel
• Volgend Excel artikel »