Van ruwe data naar analyse

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 !




Homepage

Rubriek onderdelen

Over Wim

Wim Gielis is Business Intelligence consultant en Excel expert

Andere links