Dim fc As Integer, i1%, i2%, i3%, i4&
fc = FreeFile
Open "C:\daten\demodaten.txt" For Input As #fc
 
Dim i2_col As New Collection, i3_col As New Collection
Dim freq(10000) As Integer 'Eventuell mit Redim Preserve dynamisch verländern 
 
Dim index As Integer, vorhanden As Boolean
While Not EOF(fc)
   Input #fc, i1, i2, i3, i4
   vorhanden = False
   For index = 1 To i2_col.count
      If i2_col(index) = i2 And i3_col(index) = i3 Then
        freq(index) = freq(index) + 1: vorhanden = True: Exit For
      End If
   Next index
 
   If Not vorhanden Then
      i2_col.Add (i2): i3_col.Add (i3): freq(i2_col.count) = 1
   End If
Wend
 
Close #fc
 
Open "C:\daten\demoresult.txt" For Output As #fc
For index = 1 To i2_col.count
   Print #fc, CStr(i2_col(index)) & " - " & CStr(i3_col(index)) & _
   ": " & CStr(freq(index))
Next index
 
Close #fc

While Not EOF(fc)
   Input #fc, i1, i2, i3, i4
   vorhanden = False
   If Not (i1 = i2 or i1 = i3 _
      or i4 = i2 or i4 = i3) Then
      For index = 1 To i2_col.count
         If i2_col(index) = i2 And i3_col(index) = i3 Then
           freq(index) = freq(index) + 1: vorhanden = True: Exit For
         End If
      Next index
      If Not vorhanden Then
       i2_col.Add (i2): i3_col.Add (i3): freq(i2_col.count) = 1
      End If
  End If
 
Wend

Public Function Contains(col As Collection, vl As Variant) As Boolean
    Contains = False
    Dim index As Integer
    For index = 1 To col.count
       If col(index) = vl Then Contains = True: Exit For
    Next index
End Function

Dim fc%, i1%, i2%, i3%, i4%
 
fc = FreeFile
 
'1. Ermittlung der Werte in Spalte 1 und Spalte 4
Open "C:\daten\demodaten.txt" For Input As #fc
 
Dim i1_col As New Collection, i4_col As New Collection
While Not EOF(fc)
 
  Input #fc, i1, i2, i3, i4
  If Not Contains(i1_col, i1) Then i1_col.Add i1
  If Not Contains(i4_col, i4) Then i4_col.Add i4
 
Wend
 
Close #fc
 
'2. gefilterte Häufigkeit der Zahlenkombinationen in Spalte 2 / 3
Open "C:\daten\demodaten.txt" For Input As #fc
 
Dim i2_col As New Collection, i3_col As New Collection
Dim freq(10000) As Integer
 
Dim index As Integer, count As Integer, vorhanden As Boolean
While Not EOF(fc)
   Input #fc, i1, i2, i3, i4
   vorhanden = False
   If Not (Contains(i1_col, i2) Or Contains(i1_col, i3) _
      Or Contains(i4_col, i2) Or Contains(i4_col, i3)) Then
 
      vorhanden = False
      For index = 1 To i2_col.count
         If i2_col(index) = i2 And i3_col(index) = i3 Then
            freq(index) = freq(index) + 1: vorhanden = True: Exit For
         End If
      Next index
 
      If Not vorhanden Then
         i2_col.Add (i2): i3_col.Add (i3): freq(i2_col.count) = 1
      End If
   Else
      'Bedingung: gefilterter Datensatz
      '.....
   End If
Wend
 
Close #fc
 
'3. Füllen der Ergebnisdatei: gefilterte Zahlenkombis, Häufigkeiten
Open "C:\daten\demoresult.txt" For Output As #fc
 
For index = 1 To i2_col.count
   Print #1, CStr(i2_col(index)) & " - " & CStr(i3_col(index)) & _
   ": " & CStr(freq(index))
Next index
 
Close #fc

Dim arr1(100) As String, arr2(100) As String
   Dim arr3(100) As String, arr4(100) As String
   Dim p As Long, p1 As Long, p2 As Long, i As Long
   Dim i1$, i2$, i3$, i4$, t$
 
   Open "jbl.txt" For Input As #1
 
   While Not Eof(1)
        i = i + 1
      If UBound(arr1) < i Then
         ReDim Preserve arr1(i + 100)
         ReDim Preserve arr2(i + 100)
         ReDim Preserve arr3(i + 100)
         ReDim Preserve arr4(i + 100)
      End If
 
      Input #1,  i1, i2, i3, i4
      arr1(i) = Trim$(i1) : arr2(i) = Trim$(i2)
      arr3(i) = Trim$(i3) : arr4(i) = Trim$(i4)
   Wend
   Close
 
   For p = 1 To i
      For p1 = 1 To i
         If arr2(p) = arr1(p1) Or arr2(p) = arr4(p1) Or _
               arr3(p) = arr1(p1) Or arr3(p) = arr1(p1) Then
            arr2(p) = ""
            Exit For
         End If
      Next
      If Len(arr2(p)) Then arr2(p) = arr2(p) & " - " & arr3(p)
   Next
 
   Open "result.txt" For Output As #1
   For p = 1 To i-1
      p2 = 0 : t = ""
      If Len(arr2(p)) Then
         p2 = 1 : t = arr2(p)
      End If
 
      For p1 = p + 1 To i
         If p2 = 0 Then Exit For
         If arr2(p) = arr2(p1) Then
            arr2(p1) = "" : p2 = p2 + 1
         End If
      Next
      If p2 > 0 Then Print #1, t; " :"; Str$(p2)
 
   Next
   If Len(arr2(i)) Then Print #1, arr2(i); " : 1"
   Close

Private Type Line_Input
   i1 As Integer
   i2 As Integer
   i3 As Integer
   i4 As Integer
End Type

Private Function Readlines(ByVal filename, _
              ByRef filedata() As Line_Input) As Boolean
 
   On Error GoTo fehler
 
   Dim line As String, values() As String
   Dim fc As Integer, index As Integer
 
   Readlines = False
 
   ReDim filedata(100)
   fc = FreeFile
 
   Open filename For Input As #fc
 
   While Not EOF(fc)
      Line Input #fc, line
      values() = Split(line, ",")
      If Not UBound(values) = 3 Then Exit Function
      index = index + 1
 
      If UBound(filedata) = index Then
         ReDim Preserve filedata(index + 100)
      End If
 
      With filedata(index)
        .i1 = CInt(values(0))
        .i2 = CInt(values(1))
        .i3 = CInt(values(2))
        .i4 = CInt(values(3))
      End With
   Wend
 
   Close #fc
   ReDim Preserve filedata(index)
 
   Readlines = True
 
   Exit Function
 
fehler:
   End Function