Dim numbersdone(149) As Integer
Dim donecounter As Integer
 
Private Function CheckLine(ByVal sLine As String) As Boolean
 
    Dim i As Integer, k As Integer, snum() As String
    If donecounter < 0 Then CheckLine = True: Exit Function
    snum() = Split(sLine, " ")
    For i = 0 To UBound(snum)
       If IsNumeric(snum(i)) Then
          If snum(i) <> 0 Then
             For k = 0 To donecounter
                If CInt(snum(i)) = numbersdone(k) Then
                   CheckLine = False: Exit Function
                End If
             Next k
          End If
       End If
    Next i
    CheckLine = True
End Function
 
Private Sub Command1_Click()
 
 
donecounter = -1
Do
 
   Dim ic As Integer, indx As Integer, counter As Integer, sLine As String
   Dim snum() As String, MyNumbers() As Integer
   Dim i%, k%, tausch%
   ReDim MyNumbers(149)
   ic = FreeFile: counter = -1
   Open "input.txt" For Input As ic
   While Not EOF(ic)
      Line Input #ic, sLine
      If CheckLine(sLine) Then
         snum() = Split(sLine, " ")
         For indx = 0 To UBound(snum)
            If IsNumeric(snum(indx)) Then
               counter = counter + 1
               If counter > UBound(MyNumbers) Then
                  ReDim Preserve MyNumbers(counter + 149)
               End If
               MyNumbers(counter) = CInt(snum(indx))
            End If
         Next indx
      End If
   Wend
 
   Close ic
 
   If counter >= 0 Then
      ReDim Preserve MyNumbers(counter)
 
 
      Dim MyDistinctNumbers() As Integer, MyFrequencies() As Integer
 
      Call CountFrequencies(MyNumbers(), MyDistinctNumbers(), MyFrequencies())
 
      For i = 0 To UBound(MyFrequencies) - 1
         For k = i + 1 To UBound(MyFrequencies)
            If MyFrequencies(i) < MyFrequencies(k) Then
               tausch = MyFrequencies(i)
               MyFrequencies(i) = MyFrequencies(k)
               MyFrequencies(k) = tausch
               tausch = MyDistinctNumbers(i)
               MyDistinctNumbers(i) = MyDistinctNumbers(k)
               MyDistinctNumbers(k) = tausch
            End If
         Next k
     Next i
 
     Dim display As String
     display = CStr(MyDistinctNumbers(0))
     donecounter = donecounter + 1
     numbersdone(donecounter) = MyDistinctNumbers(0)
     For i = 1 To UBound(MyFrequencies)
        If MyFrequencies(i) = MyFrequencies(0) Then
          display = display & " " & CStr(MyDistinctNumbers(i))
          donecounter = donecounter + 1
          numbersdone(donecounter) = MyDistinctNumbers(i)
        End If
     Next i
 
     MsgBox display
   End If
Loop While counter > 0
 
Exit Sub
 
End Sub
 
 
 
Public Sub CountFrequencies(MyNumbers() As Integer, _
     MyDistictNumbers() As Integer, MyFrequencies() As Integer)
 
     Dim i%, k%, counter%
     Dim found As Boolean
     ReDim MyDistinctNumbers(UBound(MyNumbers))
     ReDim MyFrequencies(UBound(MyNumbers))
     MyDistinctNumbers(0) = MyNumbers(0)
     MyFrequencies(0) = 1
 
     For i = 1 To UBound(MyNumbers)
        If MyNumbers(i) <> 0 Then
           found = False
           For k = 0 To counter
              If MyDistinctNumbers(k) = MyNumbers(i) Then
                 'Zahl bereits aufgetreten --> Zählen
                 MyFrequencies(k) = MyFrequencies(k) + 1
                 found = True
                 Exit For
              End If
           Next k
 
           If Not found Then
             'Erstes Auftreten einer Zahl
              counter = counter + 1
              MyFrequencies(counter) = 1
              MyDistinctNumbers(counter) = MyNumbers(i)
           End If
        End If
     Next i
 
     ReDim Preserve MyDistinctNumbers(counter)
     ReDim Preserve MyFrequencies(counter)
 
 End Sub