wimgielis.com

Collectie & array

• 13/06/2007

	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
' https://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.

• « Vorig Excel artikel
• Volgend Excel artikel »