Private Function CompareLines3(line1%(), line2%(), outvalues%()) As Boolean
 
    'Die Routine prüft, ob in beiden Zeilen (line1, line2)
    '5 identische Werte vorhanden sind und 
    'gibt diese Werte zurück (outvalues)
 
    Dim i%, k%, id%
 
    ReDim outvalues(UBound(line1))
    id = -1
    For i = 0 To UBound(line1)
       For k = 0 To UBound(line2)
          If line1(i) = line2(k) Then
             id = id + 1
             outvalues(id) = line1(i)
          End If
       Next k
    Next i
 
    CompareLines3 = (id = 4)
End Function
 
 
Private Sub RegisterEntry(entry%(), register%(), frequency%())
 
    'Die Routine prüft, ob eine sortierte 5er Folge (Entry)
    'bereits im Register vorhanden ist und zählt die
    'Häufigkeit (in Frequency)
 
    Dim i%, k%, l%, vorhanden As Boolean
 
    For i = 1 To UBound(register, 2)
       vorhanden = True
       'Ist der Eintrag schon im Register?
       For k = 0 To UBound(register, 1)
           If Not entry(k) = register(k, i) Then
              vorhanden = False: Exit For
           End If
       Next k
 
       If vorhanden Then
          'Eintrag bereits vorhanden
          frequency(i) = frequency(i) + 1
          Exit Sub
       End If
    Next i
 
    l = UBound(register, 2)
 
    'Register für neuen Eintrag  verlängern
    ReDim Preserve register(UBound(register, 1), l + 1)
    ReDim Preserve frequency(l + 1)
 
    'neuen Eintrag notieren
    frequency(l + 1) = 1
    For k = 0 To UBound(register, 1)
       register(k, l + 1) = entry(k)
    Next k
 
End Sub
 
 
Private Sub CombiFrequencies()
 
   Dim file As String
   file = "C:\daten\angelina.txt"
 
  'Alle Zeilen lesen
   Dim lines() As String
   lines = GetLines(file)
 
   Dim i%, k%
   Dim line1%(), line2%(), outvalues%()
   Dim register%(), frequency%()
   ReDim register(4, 0)
 
   'Zeilen paarweise miteinander vergleichen
   For i = 1 To UBound(lines) - 1
      line1 = GetLine(lines(i))
      For k = i + 1 To UBound(lines)
          line2 = GetLine(lines(k))
          'Vergleichen
          If CompareLines3(line1, line2, outvalues) Then
             'bei gleicher 5er Folge: Register füllen
             RegisterEntry outvalues, register, frequency
          End If
      Next k
   Next i
 
   'Ausgabedatei füllen
   Dim ak%
   ak = FreeFile
   Open "C:\daten\output.txt" For Output As #ak
 
   For i = 1 To UBound(frequency)
      'Ab 2er Vorkommen einer 5erFolge: ausgeben
      If frequency(i) > 1 Then
 
         For k = 0 To UBound(register, 1)
            If k < UBound(register, 1) Then
               Print #ak, register(k, i) & ", ";
            Else
               Print #ak, register(k, i)
            End If
         Next k
      End If      
  Next i
 
  Close #ak
 
End Sub