Option Explicit
 
Private Type NumberDistanceType
    number As Integer
    Position As Integer
    Distance As Integer
End Type
 
Dim NumberRegister() As NumberDistanceType
 
Private Sub RegisterNumber(ByVal number As Integer, ByVal Position As Integer)
 
      'Registrierung einer Zahl (Number) incl. zeilennummer (Position)
      'und Ermittlung der Distanz zum vorherigen Auftreten dieser Zahl ( 
      ' Distance)
 
      Dim i%, pos%, found As Boolean
 
      For i = UBound(NumberRegister) To 0 Step -1
          If NumberRegister(i).number = number Then
             found = True: pos = NumberRegister(i).Position
             Exit For
          End If
      Next i
 
      i = UBound(NumberRegister) + 1
      ReDim Preserve NumberRegister(i)
      With NumberRegister(i)
         .number = number
         .Position = Position
         If found Then
            .Distance = Position - pos
         End If
      End With
End Sub
 
Private Function NumLen(ByVal number As Integer, _
                       minlen As Integer) As String
 
    NumLen = CStr(number)
    While Len(NumLen) < minlen
        NumLen = " " & NumLen
    Wend
End Function
 
 
Public Sub NumberDistance(ByVal file_in As String, _
                          ByVal Start As Integer, ByVal Ende As Integer, _
                          ByVal file_out As String)
 
 
Dim ik%, ak%  'Kanäle
Dim line As String, fields() As String 'Dateizeile
Dim dateval%  'Datum in Zeile
Dim number As Integer
 
Dim i As Integer, k As Integer 'Loopings
Dim z As Integer ' Ziehungszähler
 
'Zeit-Interval sicher stellen
If Ende < Start Then
   i = Start
   Start = Ende
   Ende = i
End If
 
ReDim NumberRegister(0)
 
ik = FreeFile
Open file_in For Input As #ik
 
While Not EOF(ik)
   Line Input #ik, line
   z = z + 1
   'numerische Felder in einer Zeile
   fields = Split(line, " ")
   'Check
   If Not UBound(fields) = 7 Then Stop
   'Datumsfeld
   dateval = CInt(fields(0))
   'Zeitfilter
   If dateval >= Start And dateval <= Ende Then
      'Häufigkeitszähler füllen
      For i = 1 To 7
          number = CInt(fields(i))
          If number > 0 Then
             Call RegisterNumber(CInt(fields(i)), z)
          End If
      Next i
   End If
Wend
Close #ik
 
QuickSort NumberRegister, 0, UBound(NumberRegister)
 
ak = FreeFile
Open file_out For Output As #ak
 
Print #ak, file_in
Print #ak, "von  "; Start; " bis "; Ende
Print #ak, "Gelesene Zeilen: "; z
Print #ak, "Registrierte Zahlen: "; UBound(NumberRegister)
Print #ak, ""
 
For i = 1 To UBound(NumberRegister)
    With NumberRegister(i)
        Print #ak, NumLen(.Position, 3); ".) Zahl: "; NumLen(.number, 3);
        If .Distance > 0 Then
            Print #ak, "  Distanz: "; NumLen(.Distance, 3)
        Else
            Print #ak, ""
        End If
    End With
Next i
Close #ak
 
End Sub
 
Private Sub QuickSort(Sort() As NumberDistanceType, ByVal Start%, ByVal Ende%)
 
  Dim i%, j%
  Dim h As NumberDistanceType
  Dim x As NumberDistanceType
 
  i = Start: j = Ende
  x = Sort((Start + Ende) / 2)
 
  Do
    While comparend(Sort(i), x) < 0: i = i + 1: Wend
    While comparend(Sort(j), x) > 0: j = j - 1: Wend
 
    If (i <= j) Then
      h = Sort(i)
      Sort(i) = Sort(j)
      Sort(j) = h
      i = i + 1: j = j - 1
    End If
  Loop Until (i > j)
 
  If (Start < j) Then QuickSort Sort, Start, j
  If (i < Ende) Then QuickSort Sort, i, Ende
End Sub
 
Private Function comparend(w1 As NumberDistanceType, w2 As NumberDistanceType) _
  As Integer
    comparend = 1
    If w1.number > w2.number Then Exit Function
    If w1.number = w2.number And _
       w1.Position > w2.Position Then Exit Function
    comparend = 0
    If w1.number = w2.number And _
       w1.Position = w2.Position Then Exit Function
    comparend = -1
End Function