Public Sub remove(ByVal Index As Integer)
   Dim it As clsBestLeistungen
   Set it = Bestlcol(Index)
   If Not it.hs = "" Then mGesamtHS = mGesamtHS - 1
   Bestlcol.remove Index
End Sub

Option Explicit
Private mGesamtHS As String
Private mGesamtSG As String
Private mGesamtHF As String
Public Property Get GesamtHS() As String  
GesamtHS = mGesamtHS
End Property
 
Public Property Let GesamtHS(ByVal MyArgument As String) 
mGesamtHS = MyArgument
End Property
 
Public Property Get GesamtSG() As String  
GesamtSG = mGesamtSG
End Property
Public Property Let GesamtSG(ByVal MyArgument As String) 
mGesamtSG = MyArgument
End Property
 
Public Property Get GesamtHF() As String   
GesamtHF = mGesamtHF
End Property
Public Property Let GesamtHF(ByVal MyArgument As String) 
mGesamtHF = MyArgument
End Property
 
Public Property Get item(ByVal Index As Long) As clsBestleistungen
Set item = BestlCol(Index)
End Property
Public Property Get count() As Long
count = BestlCol.count
End Property
Public Sub remove(ByVal Index As Integer)
BestlCol.remove Index
End Sub
 
Private Sub Class_Initialize()
Set BestlCol = New Collection
End Sub
 
Private Sub Class_Terminate()
Set BestlCol = Nothing
End Sub
 
Public Function Add(Datum As Date, Name As String, HS As String, SG As String, _
  HF As String) As clsBestleistungen
Dim DSnew As clsBestleistungen
Set DSnew = New clsBestleistungen
With DSnew
.Datum = Datum
.Name = Name
.HS = HS
.SG = SG
.HF = HF
End With
BestlCol.Add DSnew
Set Add = DSnew
Set DSnew = Nothing
End Function
Public Sub Bestl_einlesen(Spi As String)
strDSQ = "SELECT * FROM Bestleistungen WHERE Datum=" & Format(Spieltg, _
  "\#yyyy\-mm\-dd\#") & " AND Name='" & Spi & "'"
Set rsdat = DB.OpenRecordset(strDSQ, dbOpenDynaset)
With rsdat
If .EOF = True And .BOF = True Then Call Meldanz("Bisher keine Bestleistungen" & _
  "für " & Chr(13) & Spi, 3000): NewBestl.Add Spieltg, Spi, 0, 0, 0: GoTo 10
.MoveFirst
Do While Not .EOF
    NewBestl.Add Spieltg, Spi, .Fields(3), .Fields(4), .Fields(5)
    .MoveNext
Loop
.Close
End With
10 Call ermitteln_GesamtHS
Call ermitteln_GesamtSG
Call ermitteln_GesamtHF
Call Bestl_anzeigen
 
Set rsdat = Nothing
End Sub
Private Function ermitteln_GesamtHF()
GesamtHF = ""
Dim it As clsBestleistungen
For i = 1 To BestlCol.count
    Set it = BestlCol(i)
    If Not it.HF = "0" Then
        If GesamtHF = "" Then GesamtHF = GesamtHF + NewBestl.item(i).HF: GoTo 10
        If GesamtHF <> "" Then GesamtHF = GesamtHF + "," + NewBestl.item(i).HF
10  End If
Next
End Function
Private Function ermitteln_GesamtSG()
GesamtSG = ""
Dim it As clsBestleistungen
For i = 1 To BestlCol.count
    Set it = BestlCol(i)
    If Not it.SG = "0" Then
        If GesamtSG = "" Then GesamtSG = GesamtSG + NewBestl.item(i).SG: GoTo 10
        If GesamtSG <> "" Then GesamtSG = GesamtSG + "," + NewBestl.item(i).SG
10  End If
Next
End Function
Private Function ermitteln_GesamtHS()
GesamtHS = ""
Dim it As clsBestleistungen
Dim c As Integer: c = 0
For i = 1 To BestlCol.count
    Set it = BestlCol(i)
    If Not it.HS = "0" Then c = c + 1
Next
GesamtHS = CStr(c)
End Function
Private Function Bestl_anzeigen()
With frmBestl
.lblBestlSpieler.Caption = NewBestl.item(1).Name
If NewBestl.GesamtHS <> "0" Then .txtHS.Text = NewBestl.GesamtHS Else _
  .txtHS.Text = ""
If NewBestl.GesamtSG <> "0" Then .txtSG.Text = NewBestl.GesamtSG Else _
.txtSG.Text = ""
If NewBestl.GesamtHF <> "0" Then .txtHFAnzeige.Text = NewBestl.GesamtHF Else _
.txtHFAnzeige.Text = ""
End With
End Function