RSS

Egne collections i Excel VBA

Der er masser af indbyggede collections i Excel (og andre Officeprogrammer), men man kan også nemt lave sine egne. Længere nede på siden er der eksempler på makroer, der gør netop dette, men først lidt om hvad en collection er for en størrelse.

En collection er en samling af objekter, som ikke behøver at være af samme type. I Excel er der en række indbyggede collections. En workbook (XLS fil) har f.eks. en collection af worksheets ("fanebladene"). I VBA kan man adressere et worksheet efter dets nummer i samlingen. F.eks.:

ActiveWorkbook.Worksheets(1).Visible

Hvis man har givet fanebladet et navn (dobbeltklik på fanebladet og skriv et navn), kan man alternativt adressere fanebladet med navnet (eller "nøglen") i stedet for nummeret:

ActiveWorkbook.Worksheets("Data").Visible

Der er flere indbyggede collections i Excel. F.eks. er alle kontrolelementer (controls) på en formular elementer i formularens collection af kontrolelementer.

Collections ligner arrays, ved at de indeholder en samling objekter, som kan adresseres med et numerisk indeks, men collections er nemmere at have med at gøre, fordi de har nogle indbyggede metoder til at tilføje, fjerne og adressere elementerne.

Man kan tilføje og fjerne objekter, og man kan gennemløbe en collection med den hurtige løkke "For Each…Next". Hvert element (item) i en collection har et nummer og evt. en nøgle, som skal være unik.

Fælles for alle collections er, at man kan tilføje og fjerne elementer samt få at vide, hvor mange elementer samlingen indeholder:

colMyCollection.Add  item, key, before, after
colMyCollection.Remove item, key
colMyCollection.Count

Når man tilføjer et element er "item" obligatorisk, og det er den værdi, som returneres, når man beder om det. "Key" er en nøgle, man ikke behøver at bruge, men som kan være praktisk. Nøglen skal være unik og af datatypen String. Before og after bruges, hvis det nye element ikke skal tilføjes i enden af samlingen, men et bestemt sted.

Eksempler på egne collections

I det første eksempel gør vi det helt simpelt. Proceduren indlæser værdierne i cellerne A1 og ned til første tomme celle og skriver dem derefter i celle C1 og ned. Du kan markere koden, kopiere den ind i et VBA-modul og dernæst køre den. Husk at skrive noget i celle A1 og ned til f.eks. A10 - ellers sker der ikke noget!

I det andet eksempel indlæser vi kun unikke værdier (dubletter medtages altså ikke), og værdierne indlæses i alfabetisk rækkefølge. Men først det simple eksempel:


Sub SimpelCollection()
'Denne procedure indlæser værdier i cellerne A1 og ned til
'første tomme celle som elementer i en collection. Derpå
'skrives værdierne fra samlingen i celle C1 og ned.

Dim colMyCol As New Collection 'Vores collection
Dim vElement                   'Variant til at repræsentere et element
Dim rRange As Range            'Rangevariabel
Dim rCell As Range             'Rangevariabel
Dim lCount As Long             'Tæller

Set rRange = Range("A1")

'Hvis celle A1 er tom, forlades proceduren
If Len(rRange.Value) = 0 Then GoTo BeforeExit

'Hvis der står noget i celle A2, udvider vi
'rRange til sidste tomme celle under A1
If Len(rRange.Offset(1, 0).Value) > 0 Then
   Set rRange = Range(rRange, rRange.End(xlDown))
End If

'Nu indlæses celleværdierne i vores collection.
'Bemærk, at vi her IKKE giver elementerne en nøgle (key).
For Each rCell In rRange
   colMyCol.Add rCell.Value
Next

'Nu skrives værdierne i celle C1 og ned.
'Ligesom et Range kan en collection gennemløbes med en
'For Each...Next løkke.
For Each vElement In colMyCol
   Range("C1").Offset(lCount, 0).Value = vElement
   lCount = lCount + 1
Next

BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i proceduren SimpelCollection"
Resume BeforeExit
End Sub

Det næste eksempel er mere avanceret. Det indlæser for det første kun unikke værdier (altså ingen dubletter), og for det andet sorteres værdierne alfabetisk.

Det med de unikke værdier fikses ved også at tilføje værdien som nøgle (Key). Hvis nøglen eksisterer i forvejen, vil det normalt udløse en fejl, men det klarer vi ved at bruge "On Error Resume Next".

Den alfabetiske sortering klares ved at bruge den matematiske operator "<" (mindre end) og så indsætte værdien før værdier, som kommer senere i alfabetet.

Indsæt følgende i celle A1 og ned. Markér og kopiér koden ind i et VBA-modul.

London
Antwerpen
1
New York
Antwerpen
4
Bombay

Sub AvanceretCollection()
'Tilføjer værdier fra en kolonne til en collection.
'Værdierne tilføjes i alfabetisk rækkefølge og
'uden dubletter.

Dim colMyCol As New Collection 'Vores collection
Dim rRange As Range            'Rangevariabel
Dim rCell As Range             'Rangevariabel
Dim lCount As Long             'Tæller
Dim sVar As String             'Strengvariabel til vores nøgler

On Error GoTo ErrorHandle

'Vores rangevariabel sættes til celle A1
Set rRange = Range("A1")

'Hvis celle A1 er tom, forlades proceduren
If Len(rRange.Value) = 0 Then GoTo BeforeExit

'Hvis der står noget i celle A2, udvider vi
'rRange til sidste celle med indhold.
If Len(rRange.Offset(1, 0).Value) > 0 Then
   Set rRange = Range(rRange, rRange.End(xlDown))
End If

'Ved nu at skrive On Error Resume Next undgår
'vi fejl, når vi forsøger at tilføje en key,
'som allerede findes. Derved undgår vi dubletter.
On Error Resume Next

'Nu gennemløbes kolonnen (vores range)
For Each rCell In rRange
   'Et elements nøgle (key) skal være af datatypen
   'String, så hvis cellen indeholder en numerisk
   'værdi, konverteres den til en String i
   'variablen sVar. Hvis man undlader at konvertere
   'numeriske værdier, kommer de IKKE med i samlingen.
   'idet de udløser en fejl (præcis som dubletter).
   If IsNumeric(rCell.Value) Then
      sVar = Str$(rCell.Value)
   Else
      sVar = rCell.Value
   End If
   'Nu føjes celleværdierne til vores collection.
   'Vi bruger With..End for hastighedens skyld.
   With colMyCol
      'Hvis samlingen ikke er tom
      If .Count > 0 Then
         'Samlingen gennemløbes, og den nye værdi
         'sammenlignes alfabetisk med de andre i
         'samlingen og indsættes på rette plads FØR.
         'Alfabetisk rækkefølge, datoer og den slags
         'kan tjekkes med operatorerne < > og =.
         For lCount = 1 To .Count
            If rCell.Value < .Item(lCount) Then
               .Add rCell.Value, sVar, lCount
               Exit For
            End If
         Next
      End If

      'Hvis vores collection er tom, eller hvis
      'tælleren viser, at værdien alfabetisk
      'skal ind til sidst, indsættes værdien
      'på sidste plads i samlingen.
      If lCount = .Count + 1 Or .Count = 0 Then
         .Add rCell.Value, sVar
      End If
   End With
Next

On Error GoTo ErrorHandle

'For eksemplets skyld indsætter vi nu de
'sorterede værdier i celle D1 og ned.
Set rRange = Range("D1")

With colMyCol
   For lCount = 0 To .Count
      rRange.Offset(lCount, 0).Value = .Item(lCount + 1)
   Next
End With

BeforeExit:
Set colMyCol = Nothing
Set rRange = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i proceduren _
AvanceretCollection"
Resume BeforeExit
End Sub

Tip

VBA skelner mellem små og store bogstaver, og hvis et ord begynder med et lille bogstav, vil det ryge nederst på listen. Det kan du undgå ved at skrive:

Option Compare Text

øverst i modulet. Så tvinger du VBA væk fra den binære sammenligning, som er default.

Relateret: