Evolutie eredivisie

Voorbeeldbestanden bij dit artikel:
  • Evolutie eredivisie
  • Inleiding

    Uit interesse ben ik nog wat verder gegaan met de code en opzet van een recent artikel: rang en evolutie. Lees dat artikel best door vooraleer dit artikel te lezen, we bouwen verder op de aangeleerde technieken. In dat andere artikel hadden we het over hoe een staat presteert t.o.v. de andere staten wat betreft bevolkingsaangroei of -afgroei. Visueel werd via de gele duidelijk of een staat eerder hoog of laag scoort, en ook hoe die rang wijzigt doorheen de jaren.

    Eredivisie voetbal

    Jullie weten dat ik wel in voetbal geïnteresseerd ben; dit artikel gaat even over de grens kijken naar de eredivisie voetbal. Op basis van de uitslagen van de wedstrijden (en enkel dat) gaan we proberen inzichtelijk maken hoe een team opschuift of zakt in de rangschikking. Met andere woorden, wat is de plaats in het klassement na elke speeldag?

    Gebruik

    De bedoeling is dat we een ploegnaam selecteren in kolom A (zie screenshot hierna), en dan hadden we graag de evolutie in beeld gebracht. De pijlen op de illustratie en in het Excel bestand zijn Shapes. Een andere reden voor dit artikel, is dat ik tot nog toe weinig VBA-code met Shapes op mijn site gezet heb. Bij deze kunnen jullie dan de code daarvoor bestuderen en gebruiken.

    Het uitvoeren van code na het veranderen van de selectie, heet in Excel VBA een Worksheet_SelectionChange event. Excel detecteert dat de selectie gewijzigd werd, en laat jou toe om programmacode uit te voeren net op dat moment.

    PSV

    Nemen we de gegevens van PSV even ter hand (rij 13 in de spreadsheet). Kolommen B tot K tonen de uitslagen van PSV in de eerste 10 competitiewedstrijden van het seizoen 2011-2012. Kolommen M tot V zetten die standen om in de puntenevolutie van PSV: verlies op speeldag 1, dus 0 punten in totaal. Winst op speeldagen 2, 3 en 4, zodat het puntentotaal aandikt tot 3, 6, 9 punten. Gelijkspel op speeldag 5, en dan komt PSV op 10 punten. Enz. Na 10 speeldagen telt PSV 21 punten.

    De prestaties doorheen het seizoen

    Speeldag na speeldag zullen teams stijgen of dalen in de rangschikking. Mijn betrachting is het om die informatie mee te tonen in de kolommen M tot V. Dus GEEN extra tabel of berekeningen in de spreadsheet. We zullen de rang bepalen van een team in een speeldag, en een pijl gebruiken om de evolutie te tonen. Concreet komt dit voor PSV neer op:

    • plaats 14 na speeldag 1 (cel M15 is geel, dat is de 14de cel van bovenaf)
    • plaats 7 na speeldag 2 (cel N8 is geel, dat is de 7de cel van bovenaf)
    • plaats 5 na speeldag 3 (cel O6 is geel, dat is de 5de cel van bovenaf)
    • plaats 3 na speeldag 4 (cel P4 is geel, dat is de 3de cel van bovenaf)
    • plaats 5 na speeldag 4 (cel Q6 is geel, dat is de 5de cel van bovenaf)
    • enz.
    • na speeldag 10 staat PSV op de 2de plaats (kolom W)

    VBA-code

    Wat is de VBA-code hierachter? Bekijk de code gerust in het bestand dat je bovenaan de pagina kan downloaden.

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' Wim Gielis ' http://www.wimgielis.com
    ''''' ' Worksheet_SelectionChange event code ' 28/10/11 '''''
    If Target.Count = 1 Then If Not Application.Intersect(Target, ActiveSheet.UsedRange.Columns(1)) Is Nothing Then Call HighlightEvolution(Target) End If End If
    End Sub

    Die is alvast het Worksheet_SelectionChange event. Daarbij kan je gebruik maken van de variabele Target, die we meegeven aan de procedure HighlightEvolution. Je mag slechts 1 cel (ploeg) selecteren. Cel A1 doet dienst als "reset cel": klik die aan en de kleuren en shapes verdwijnen.

    Sub HighlightEvolution(rngTeam As Range)
    ' Wim Gielis ' http://www.wimgielis.com
    Const iNR_OF_TEAMS As Integer = 18 Const sADDRESS_WEEKS As String = "M1:V1" Const sSHAPE_NAME As String = "Evolutie" Dim rngWeek As Range Dim lRank As Long Dim l As Long Dim rngCelPoints_0 As Range Dim rngCelPoints_1 As Range Dim sCellsOfRanks() As String 'remove highlighting and arrows ColorArea Range("B2").Resize(iNR_OF_TEAMS, Range(sADDRESS_WEEKS).Count), 0, 0 ColorArea Range(sADDRESS_WEEKS).Offset(1).Resize(iNR_OF_TEAMS), 0, 0 On Error Resume Next ActiveSheet.Shapes(sSHAPE_NAME).Delete On Error GoTo 0 'apply formatting again, cell A1 acts as the "reset cell" If rngTeam.Row > 1 Then ReDim sCellsOfRanks(Range(sADDRESS_WEEKS).Count - 1) 'loop through the years of the dataset and record the cells for later use For Each rngWeek In Range(sADDRESS_WEEKS) lRank = WorksheetFunction.Rank(Cells(rngTeam.Row, rngWeek.Column), rngWeek.Offset(1).Resize(iNR_OF_TEAMS)) sCellsOfRanks(rngWeek.Column - Range(sADDRESS_WEEKS).Column) = rngWeek.Offset(lRank).Address Next For l = 0 To UBound(sCellsOfRanks) 'relative ranks in yellow Set rngCelPoints_0 = Range(sCellsOfRanks(l)) ColorArea rngCelPoints_0, 6, 6 'arrows to mark the evolution If l < UBound(sCellsOfRanks) Then Set rngCelPoints_1 = Range(sCellsOfRanks(l + 1)) Else Set rngCelPoints_1 = Range(sCellsOfRanks(l)).Offset(, 1) End If With ActiveSheet.Shapes.AddLine(rngCelPoints_0.Left + rngCelPoints_0.Width / 2, _ rngCelPoints_0.Top + rngCelPoints_0.Height / 2, _ rngCelPoints_1.Left + rngCelPoints_1.Width / 2, _ rngCelPoints_1.Top + rngCelPoints_1.Height / 2) .Line.Weight = 1.5 .Line.EndArrowheadStyle = msoArrowheadTriangle 'trace the name to group shapes later on sCellsOfRanks(l) = .Name End With Next ActiveSheet.Shapes.Range(sCellsOfRanks).Group.Name = sSHAPE_NAME 'aggregated values in green ColorArea Range("B" & rngTeam.Row).Resize(, Range(sADDRESS_WEEKS).Count), 43, 0 ColorArea Range(sADDRESS_WEEKS).Offset(rngTeam.Row - Range(sADDRESS_WEEKS).Row), 43, 0 End If
    End Sub

    Private Sub ColorArea(rng As Range, lInteriorColor As Long, lFontColor As Long)
    rng.Interior.ColorIndex = lInteriorColor rng.Font.ColorIndex = lFontColor
    End Sub

    Schrik niet van al die code, gebruik een breakpoint en F8 om in VBA meer inzicht te krijgen in de code. Deel 1 van de code zal de huidige opmaak (kleuren en pijlen) wegnemen. Vervolgens zullen we dan een lus maken doorheen de speeldagen: voor de gekozen ploeg (PSV bijvoorbeeld) bepalen we de rang en kleuren we de cel geel. We tekenen tevens de pijl voor de evolutie: de eigenschappen Top, Left, Height en Width van een cel bepalen waar een pijl precies begint en stopt.

    Shapes

    Niet vergeten dat we ook in een array de namen van de shapes; zo kunnen we later makkelijk in 1 statement alle shapes groeperen en houden we 1 (grote) shape over in plaats van 10 shapes (de 10 pijlen worden gegroepeerd tot 1 shape). Dit biedt als voordeel dat bestaande pijlen deleten makkelijk kan aangezien we toch maar 1 object ons interesseert. Kijk ook even naar de aparte kleine procedure voor het zetten van kleurtjes (of wegnemen van kleurtjes, casu quo).




    Over Wim

    Wim Gielis is Business Intelligence consultant en Excel expert

    Andere links