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()
Dim colMyCol As New Collection
Dim vElement
Dim rRange As Range
Dim rCell As Range
Dim lCount As Long
Set rRange = Range("A1")
If Len(rRange.Value) = 0 Then GoTo BeforeExit
If Len(rRange.Offset(1, 0).Value) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
For Each rCell In rRange
colMyCol.Add rCell.Value
Next
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()
Dim colMyCol As New Collection
Dim rRange As Range
Dim rCell As Range
Dim lCount As Long
Dim sVar As String
On Error GoTo ErrorHandle
Set rRange = Range("A1")
If Len(rRange.Value) = 0 Then GoTo BeforeExit
If Len(rRange.Offset(1, 0).Value) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
On Error Resume Next
For Each rCell In rRange
If IsNumeric(rCell.Value) Then
sVar = Str$(rCell.Value)
Else
sVar = rCell.Value
End If
With colMyCol
If .Count > 0 Then
For lCount = 1 To .Count
If rCell.Value < .Item(lCount) Then
.Add rCell.Value, sVar, lCount
Exit For
End If
Next
End If
If lCount = .Count + 1 Or .Count = 0 Then
.Add rCell.Value, sVar
End If
End With
Next
On Error GoTo ErrorHandle
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:
|