Option Explicit
 
Dim numbersdone(100) 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(100)
   ic = FreeFile: counter = -1
   Open "F:\Daten\Neues Textdokument.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 + 100)
               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
 
End Sub
 
Public Sub CountFrequencies(mynumbers() As Integer, _
     MyDistinctNumbers() 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
                 MyFrequencies(k) = MyFrequencies(k) + 1
                 found = True
                 Exit For
              End If
           Next k
           If Not found Then
              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