ReDim PersDatensatzArr(500)
ReDim PersDatensatzIdxArr(500)
PersDatensatzArrCount = 0

Option Explicit
 
Public Type MyPersDatensatz
    StrFeld1 As String
    StrFeld2 As String
    StrFeld3 As String
    StrFeld4 As String
    LngFeld1 As Long
End Type
 
Public PersDatensatzArr() As MyPersDatensatz
Public PersDatensatzIdxArr() As Long
Public PersDatensatzArrCount As Long
 
Public Function ComparePersDatensatz(ByRef d1 As MyPersDatensatz, ByRef d2 As _
  MyPersDatensatz) As Long
    '-1: 1. Datensatz < 2. Datensatz
    ' 0: 1. Datensatz = 2. Datensatz
    ' 1: 1. Datensatz > 2. Datensatz
    Dim tmp As Long
    ' Name vergleichen
    tmp = StrComp(d1.StrFeld1, d2.StrFeld1, vbBinaryCompare)
    If tmp = 0 Then
        tmp = StrComp(d1.StrFeld2, d2.StrFeld2, vbBinaryCompare)
        If tmp = 0 Then
            tmp = StrComp(d1.StrFeld3, d2.StrFeld3, vbBinaryCompare)
            If tmp = 0 Then
                tmp = StrComp(d1.StrFeld4, d2.StrFeld4, vbBinaryCompare)
                If tmp = 0 Then
                    tmp = CompareLng(d1.LngFeld1, d2.LngFeld1)
 
                End If
            End If
        End If
    End If
    ComparePersDatensatz = tmp
End Function
 
Private Function CompareLng(l1 As Long, l2 As Long)
    If l1 < l2 Then
        CompareLng = -1
    ElseIf l1 = l2 Then
        CompareLng = 0
    Else
        CompareLng = 1
    End If
End Function
 
 
Public Function FuegeDatensatzEinOhneDuplikat(Datensatz As MyPersDatensatz) As _
  Boolean
    'Zuerst nachsehen, ob Datensatz schon vorhanden
    Dim tmp As Long
    Dim retVal As Long
    tmp = BinaereSuche(Datensatz)
    If tmp < 0 Then 'Datensatz ist noch nicht vorhanden
        DatensatzEinfuegen Datensatz, -tmp - 1
        retVal = True
    Else 'Datensatz ist bereits vorhanden, daher nichts machen
        retVal = False
    End If
    FuegeDatensatzEinOhneDuplikat = retVal
End Function
 
' wenn Ret > 0, wurde Datensatz gefunden
'ansonsten  wird  (-Einfügepos - 1) zurückgegeben
Private Function BinaereSuche(Datensatz As MyPersDatensatz) As Long
    Dim Ergebnis As Long, UntereGrenze As Long, ObereGrenze As Long, Mitte As _
      Long, VerglErg As Long
    Dim retVal As Long
    UntereGrenze = 0
    ObereGrenze = PersDatensatzArrCount - 1
    Ergebnis = -1
 
    If PersDatensatzArrCount = 0 Then
        retVal = -1
    Else
 
        Do While UntereGrenze <= ObereGrenze And Ergebnis < 0
            Mitte = UntereGrenze + ((ObereGrenze - UntereGrenze) / 2)
            VerglErg = ComparePersDatensatz(PersDatensatzArr( _
              PersDatensatzIdxArr(Mitte)), Datensatz)
            If VerglErg < 0 Then 'rechts weitersuchen
                UntereGrenze = Mitte + 1
            ElseIf VerglErg > 0 Then 'links weitersuchen
                ObereGrenze = Mitte - 1
            Else ' gefunden
                Ergebnis = Mitte
            End If
 
        Loop
 
        If Ergebnis = -1 Then ' nicht in Liste, Einfügpos zurückgeben
            retVal = (-UntereGrenze - 1)
        Else 'Gefunden, Fundposition zurückgeben
            retVal = Ergebnis
        End If
 
    End If
 
    BinaereSuche = retVal
End Function
 
Private Sub DatensatzEinfuegen(Datensatz As MyPersDatensatz, EinfuegPos As Long)
    If UBound(PersDatensatzArr) <= PersDatensatzArrCount Then
        ReDim Preserve PersDatensatzArr(UBound(PersDatensatzArr) + 100)
        ReDim Preserve PersDatensatzIdxArr(UBound(PersDatensatzArr) + 100)
    End If
    ' Datensatz im normalen Array am Schluss einfügen
    PersDatensatzArr(PersDatensatzArrCount) = Datensatz
 
    ' Werte im Index-Array verschieben
    Dim i As Long
    For i = PersDatensatzArrCount - 1 To EinfuegPos Step -1
        PersDatensatzIdxArr(i + 1) = PersDatensatzIdxArr(i)
    Next
    PersDatensatzIdxArr(EinfuegPos) = PersDatensatzArrCount
    PersDatensatzArrCount = PersDatensatzArrCount + 1
End Sub