Collectie & array

Voorbeeldbestanden bij dit artikel:
  • Collectie & array
  • Inleiding

    Op deze pagina ga je wat meer uitleg VBA-code vinden over enkele meer geavanceerde mogelijkheden en concepten in VBA. Onder andere:

    • het gebruik van een collectie
    • het gebruik van array‘s
    • het programmeren van de autofilter
    • het splitsen van tekst in cellen in woorden
    • de SpecialCells eigenschap

    Toepassing

    Om de code wat in te kleden, is hier een toepassing. Het was eigenlijk de toepassing waarvoor ik deze code schreef, een vraag op Helpmij. Zie hier de uitgangssituatie en wat het zou moeten worden:

    De bedoeling is dus dat de som wordt gemaakt van alle getallen (kolom Number), voor elk afzonderlijk woord (kolom Words). Ik was begonnen met het onder elkaar schrijven van elk van de 7 unieke woorden. Vervolgens stelde ik via gewone Excel functies een grote functie samen die de juiste som maakt voor elk van de 7 woorden. Niet gemakkelijk, maar ook niet ondoenbaar. In de topic waaraan ik refereerde, staat de gebruikte formule. Maar dan komt het…

    Wat als je een lange lijst met woorden en getallen hebt, waardoor het praktisch onbegonnen werk is om alle verschillende woorden zelf te zoeken? Dan ga je VBA-code schrijven natuurlijk. Dat deed ik. Het bestand en de code (uitleg staat daaronder) kan je downloaden aan het begin van dit artikel.

    Option Explicit
    Option Base 1
    
    
    Sub CollectieArray()
    ' Wim Gielis ' http://www.wimgielis.com
    ''''' ' VBA-code to sum numbers based on parts of cells (illustrates the use of collection, array, autofilter) ' 13/06/07 '''''
    Dim rCell As Range Dim rRng As Range Dim colUnique As Collection Dim sCellContents As String Dim arrWords() As String Dim lIndex As Long Dim rngColHeaders As Range Dim rngOutput As Range Dim rngAF As Range Dim rngAFfiltered As Range Dim arrResults() As Variant Application.ScreenUpdating = False Set rRng = Range("A2", Range("A" & Rows.Count).End(xlUp)) Set rngColHeaders = Range("A1:B1") Set rngOutput = rngColHeaders.Offset(, rngColHeaders.Count) Set colUnique = New Collection rngOutput.EntireColumn.ClearContents 'loop through the cells adding parts of them to a collection 'cell contents are split at spaces using the SPLIT function 'no duplicate keys For Each rCell In rRng.Cells sCellContents = Trim(rCell.Text) arrWords = Split(sCellContents) For lIndex = LBound(arrWords) To UBound(arrWords) On Error Resume Next colUnique.Add arrWords(lIndex), arrWords(lIndex) On Error GoTo 0 Next lIndex Next rCell ReDim arrResults(colUnique.Count - 1, 1) 'loop through the collection and add to array For lIndex = 1 To colUnique.Count arrResults(lIndex - 1, 0) = colUnique(lIndex) Next lIndex 'autofilter in loop For lIndex = LBound(arrResults) To UBound(arrResults) ActiveSheet.AutoFilterMode = False With rngColHeaders .AutoFilter .AutoFilter Field:=1, Criteria1:="=*" & arrResults(lIndex, 0) & "*" Set rngAF = ActiveSheet.AutoFilter.Range On Error Resume Next 'visible cells in column B autofilter returns Set rngAFfiltered = rngAF.Offset(1, 1).Resize(rngAF.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 'second column of array holds sum of numbers arrResults(lIndex, 1) = WorksheetFunction.Sum(rngAFfiltered) End With Next lIndex ActiveSheet.AutoFilterMode = False With rngOutput 'output array to sheet .Resize(UBound(arrResults) + 1, 2).Value = arrResults 'sort alphabetically on column C .EntireColumn.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo 'autofit .EntireColumn.AutoFit End With Application.ScreenUpdating = True
    End Sub

    Uitleg in stappen

    Je kan al wel raden dat de geavanceerde VBA-code die ik hier gebruikte niet zomaar gedaan is. Niet alleen wil ik jullie nieuwe concepten aanleren, ook is de macro supersnel. De 5 cellen werden berekend in 0,03 seconden op mijn computer. Veel hangt natuurlijk wel af van hoeveel verschillende woorden je hebt, want voor elk uniek woord wordt de autofilter toegepast. Kan je (het meeste van) de code begrijpen? In mensentaal is dit wat er gebeurt:

    1. inlezen van de woorden in een Collectie
      • wandel door elk van de cellen, één voor één
      • Split maakt een Array met daarin alle woorden uit een cel
      • een lus door elke Array voegt woorden toe aan de collectie
      • "On Error Resume Next" verhindert een foutmelding als je hetzelfde woord (bv. tas) meer dan eens wil toevoegen
    2. overzetten van de woorden in een Array
      • met een lus doorheen de Collectie zet je elk woord over naar een Array
      • die Array heeft de naam arrResults
    3. voor elk woord een Autofilter uitvoeren
      • alle UNIEKE woorden staan nu in een Array
      • we berekenen nog de som van de nummers voor elk woord
      • we maken een lus doorheen de woorden en doen telkens een Autofilter
      • het criterium is dat kolom A het woord bevat
      • vandaar de wildcard characters * vóór en achter
      • de SpecialCells eigenschap met argument xlCellTypeVisible geeft een bereik met alle zichtbare cellen (die dus voldoen aan de Autofilter)
      • met WorksheetFunction.Sum tellen wie getallen op
    4. resultaten wegschrijven naar het werkblad
      • de Array arrResults wordt op het werkblad gezet
    5. voorts
      • sorteer op de woorden in kolom C
      • maak de kolommen passend met Autofit

    In de praktijk

    Nuttige toepassingen? Jazeker! De vraagsteller uit de link van bovenaan de pagina natuurlijk (anders had ik die code ook wellicht nooit geschreven). Ik denk ook aan klantenamen in kolom A en factuurbedragen in kolom B. Of leveranciers. Het spreekt voor zich dat de SOM-functie ook eender welke andere functie kan zijn. Mijn code is hier algemeen genoeg om dat eenvoudig aan te passen. Of wat dacht je van een puntenlijst van studenten? Toepassingen genoeg, mits eventueel wat licht aanpassen van de code.




    Over Wim

    Wim Gielis is Business Intelligence consultant en Excel expert

    Andere links