Option Explicit
 
Private Type Line
    Group As Integer
    Value As Integer
End Type
 
Private Type Kombi
    Group As Integer
    V1() As Integer
    V2() As Integer
End Type
 
Private Type Freq
    V1 As Integer
    V2 As Integer
    groups() As Integer
End Type
 
 
Dim Lines() As Line, kombis() As Kombi, Freqs() As Freq
 
 
Private Sub Form_Load()
 
   'Daten-Liste lesen
   ReadLines "C:\Daten\input.txt" 'Datei angeben
 
   'Liste der Gruppen erstellen (incl. Wertearray für jede Gruppe)
   SetLinesToKombis
 
   'Liste der Werte-Kombinationen bei jeder Gruppe (Gruppe -> Kombis)
   SetKombisInGroups
 
   'Liste Umsetzen: Gruppe -> Kombis nach Kombi -> Gruppen
   FillKombiGroupsList
 
   'Sortieren der Werte-Kominationen nach Anzahl Gruppen pro Kombi. / fallend
   SortKombiGroupsList
 
   'Liste ausgeben
   WriteKombiGroupsList "C:\daten\output.txt" 'Ausgabedatei angeben
 
End Sub
 
 
Sub ReadLines(file_in As String)
 
    Dim i&, k&, ln$, f$()
    Open file_in For Input As #1
 
    While Not EOF(1)
        i = i + 1
        Line Input #1, ln
    Wend
    Close #1
 
    ReDim Lines(i)
    i = 0
    Open file_in For Input As #1
    While Not EOF(1)
        i = i + 1
        Input #1, ln
        f = Split(ln, Chr(9)) '?????? Tab
        'Oder:
        ln = Replace(ln, "  ", " ")
        f = Split(ln, " ")
        Lines(i).Group = CInt(Trim(f(0)))
        Lines(i).Value = CInt(Trim(f(1)))
    Wend
    Close #1
End Sub
 
 
Sub SetLinesToKombis()
 
    Dim i&, k&, l&, foundg As Boolean, foundv As Boolean
    ReDim kombis(0)
 
    For i = 1 To UBound(Lines)
 
        'Gruppe suchen
        foundg = False
        For k = 1 To UBound(kombis)
           foundg = kombis(k).Group = Lines(i).Group
 
           If foundg Then
 
              'Wert in Gruppenliste ergänzen
              With kombis(k)
                foundv = False
                For l = 1 To UBound(.V1)
                   foundv = .V1(l) = Lines(i).Value
                   If foundv Then Exit For
                Next l
                'Wert in Gruppenliste anhängen
                If Not foundv Then
                   l = UBound(.V1) + 1
                   ReDim Preserve .V1(l)
                   .V1(l) = Lines(i).Value
                End If
              End With
              Exit For
 
           End If
 
        Next k
 
        If Not foundg Then
 
           'Gruppe in Gruppenliste anhängen
           l = UBound(kombis) + 1
 
           ReDim Preserve kombis(l)
           With kombis(l)
              'Wertliste für neue Gruppe starten
              .Group = Lines(i).Group
              ReDim Preserve .V1(1)
              .V1(1) = Lines(i).Value
           End With
 
        End If
    Next i
 
End Sub

Sub SetKombisInGroups()
 
   Dim i&, k&, l&, m&, gv&()
   For i = 1 To UBound(kombis)
      With kombis(i)
          'Werteliste der Gruppe lesen
          ReDim gv(UBound(.V1))
          For k = 1 To UBound(.V1)
             gv(k) = .V1(k)
          Next k
 
          'Werte-Kombinationen (Paarungen) in Listen der Gruppe eintragen
          m = UBound(.V1)
          ReDim .V1((m ^ 2 - m) / 2)
          ReDim .V2(UBound(.V1))
          m = 0
          For k = 1 To UBound(gv) - 1
             For l = k + 1 To UBound(gv)
                 m = m + 1
                 .V1(m) = gv(k)
                 .V2(m) = gv(l)
             Next l
          Next k
      End With
   Next i
End Sub
 
 
Private Sub FillKombiGroupsList()
 
   Dim i&, k&, l&, m&, n&, foundk, foundg As Boolean
   ReDim Freqs(0)
 
   For i = 1 To UBound(kombis)
       'Schleife über Gruppen
       With kombis(i)
           'Schleife über Wertepaare in Gruppe
           For k = 1 To UBound(.V1)
              foundk = False
              For l = 1 To UBound(Freqs)
                  'Wertepaarung suchen
                  If Freqs(l).V1 = .V1(k) And _
                     Freqs(l).V2 = .V2(k) Then
                     'Bei Wertepaarung eine zugehörige Gruppe anhängen
                     foundk = True
                     n = UBound(Freqs(l).groups) + 1
                     ReDim Preserve Freqs(l).groups(n)
                     Freqs(l).groups(n) = .Group
                     Exit For
                  End If
              Next l
              If Not foundk Then
                 'Wertepaarung anhängen
                 l = UBound(Freqs) + 1
                 ReDim Preserve Freqs(l)
                 Freqs(l).V1 = .V1(k): Freqs(l).V2 = .V2(k)
                 ReDim Freqs(l).groups(1)
                 Freqs(l).groups(1) = kombis(i).Group
              End If
           Next k
       End With
   Next i
End Sub
 
 
Private Sub SortKombiGroupsList()
 
   'nach Häufigkeiten (= Anzahl Gruppen) fallend sortieren
   Dim i%, k%, f As Freq
   For i = 1 To UBound(Freqs) - 1
      For k = i + 1 To UBound(Freqs)
         If UBound(Freqs(i).groups) < UBound(Freqs(k).groups) Then
            f = Freqs(i)
            Freqs(i) = Freqs(k)
            Freqs(k) = f
         End If
      Next k
   Next i
End Sub
 
 
Private Sub WriteKombiGroupsList(file_out As String)
   Dim i%, k%
 
   Open file_out For Output As #1
   For i = 1 To UBound(Freqs)
      With Freqs(i)
         Print #1, .V1, .V2, "  F = "; UBound(.groups)
         For k = 1 To UBound(.groups)
            Print #1, .groups(k)
         Next k
      End With
   Next i
   Close #1
End Sub

Zitat:

Die Fragestellung ist auch nicht völlig klar. Können negative Werte auftreten? Können Werte innerhalb einer Gruppe mehrfach vorkommen? Können die Ausgangsdaten in der Datei als irgendwie vorsortiert angenommen werden?

'Oder:
        ln = Replace(ln, "  ", " ")
        'f = Split(ln, " ")
        Lines(i).Group = CInt(Trim(f(0)))
        Lines(i).Value = CInt(Trim(f(1)))

 1             2             F =  10
 2000
 1888 
 1789 
 1629
usw.
usw.

 2000
 1             9             F =  46
 1             3             F =  23
 1             4             F =  51
usw.
usw.
 
 1999
 1             8             F =  20
 1             2             F =  23
 1             7             F =  30

Zitat:

Dieser Output- Eintrag ..... 1 2 F = 10 2000 1888 1789 1629 bedeutet: Die Kombination der beiden Werte 1, 2 ist in den Daten-Zeilen insgesamt 10x enthalten. Danach werden die 10 Gruppen, die diese Werte-Paarung (1,2) enthalten, gelistet.

Zitat:

Wenn zunächst eine bestimmte Gruppe ausgegeben wird, was soll dieser Gruppe als Häufigkeit zugeordnet werden ??? Eine Gruppe enthält jede Werte-Kombination ein mal (weil Deinen Angaben zufolge, so weit ich erinere, sich Werte in einer Gruppe nicht wiederholen).

Zitat:

Was spricht gegen eine einfache DB-Anwendung?

Zitat:

Was spricht gegen eine einfache DB-Anwendung?

Zitat:

Ist ja eine tolle Idee von dir - nur ich dachte es sollte so wenig Aufwand wie möglich sein.

Zitat:

Kombinationen erstellt man über einen entsprechenden Algorithmus. Dazu gibt es in diesem Forum bereits Themen und Vorschläge.

Zitat:

Ich bin nicht böse. Hast Du ausgerechnet, welche Datenmengen produziert würden. Nutze den Binomialkoeffizienten und prüfe, wieviele Kombinationen es gibt, wenn alle 3er, 4er, ...10er-Kombis zu max. 104 Werten pro Gruppe ausgegeben werden.

104 über 2 = 5356 (ist bereits im VBCode)
 
104 über 3 = 182104 (wäre sinnvoll)
 
104 über 4 = 4598126 (wäre sinnvoll)
 
104 über 5 = 91962520 (sinnlos)
 
104 über 6 = 1517381580 (sinnlos)
 
104 über 7 = 21243342120 (sinnlos)
 
104 über 8 = 257575523205 (sinnlos)
 
104 über 9 = 2747472247520 (sinnlos)
 
104 über 10 = 26100986351440 (sinnlos)

Was spricht gegen eine einfache DB-Anwendung?
 
Eine Tabelle, die drei Spalten enthält: Gruppe, Wert1, Wert2
Jeder Datensatz stünde für eine Werte-Kombi in einer Gruppe.
(Eventuell kann man Vorteile aus Normalformen gewinnen:
Liste der Gruppen, Liste der Werte, Zuordnungstabelle über SatzIds)
 
Daraus ließe sich z.B. per SQL abfragen:
- Häufigkeit einer Paarung in allen Gruppen
- Liste der Gruppen, die eine Paarung enthalten
- Liste der Paarungen einer Gruppe
 
Natürlich könnte man zusätzlich Einschränkungen einbeziehen,
z.B. Bereich der Werteausprägungen oder der Gruppen-Ausprägungen

   Sub Wertekombinationen_ausgeben(filename As String, _
      values() As Integer, kstart%, kend%)
 
      'Filename: Ausgabedatei für Kombinationen
      'values: Array mit den zu kombinierenden Werten
      'kstart: kleinste Kombination (mindestens 1)
      'kend: größte Kombination (maximal ubound(values)+1)
 
      Dim ak%, i%: ak = FreeFile
      If kend > UBound(values) + 1 Then kend = UBound(values) + 1
 
      Open filename For Append As #ak
      For i = kstart To kend
         NueberK_Output values, i, ak
      Next i
      Close #ak
   End Sub
 
 
   Sub NextIndex(ByRef indices() As Integer, n%)
 
        'Ermittlung der nächsten Indizierung bei
        'Kombinationen ohne Zurücklegen
 
        Dim j%, k%, l%, m%
        k = UBound(indices) + 1
 
        If indices(0) = -1 Then
            'Startwerte erstellen
            For j = 0 To k - 1
                indices(j) = j
            Next j
            Exit Sub
        End If
 
        m = -1
        For j = k - 1 To 0 Step -1
            m = m + 1
            If indices(j) < n - 1 - m Then
                indices(j) = indices(j) + 1
                For l = j + 1 To k - 1
                    indices(l) = indices(l - 1) + 1
                Next
                Exit For
            End If
        Next j
 
     End Sub
 
 
    Function NueberK(n%, k%) As Double
 
        'Binomialkoeffizient berechnen
        NueberK = -1
        If k < 1 Then Exit Function
        If n < k Then Exit Function
 
        Dim j%
        Dim zw#: zw = 1
        Dim nw#: nw = 1
        For j% = 0 To k - 1
            zw = zw * (n - j): nw = nw * (j + 1)
        Next j
 
        NueberK = zw / nw
 
    End Function
 
 
    Function NueberK_Output(values() As Integer, k%, _
        kanal_out As Integer) As Boolean
 
        'Liste aller Kombinationen der Werte in Values
 
        'values: null-basiertes Array mit Werteliste n = ubound(values)+1)
        'k: Anzahl der Werte in einer Kombination
        'Ausgabe in den Output_kanal
 
        On Error GoTo fehler
        NueberK_Output = False
 
        Dim indices%()
        ReDim indices%(k - 1)
        indices(0) = -1
 
        Dim anz&
        anz = CLng(NueberK(UBound(values) + 1, k))
        If anz = -1 Then Exit Function
 
        Dim i&, j%
        For i = 1 To anz
            NextIndex indices, UBound(values) + 1
            For j = 0 To k - 1
               Print #kanal_out, values(indices(j));
            Next j
            Print #kanal_out, ""
        Next i
 
        NueberK_Output = True
        Exit Function
 
fehler:
 
    End Function

Function NueberK_Output(values() As Integer, k%, kanal_out As Integer) As _
  Boolean
 
     'Liste aller Kombinationen der Werte in Values
 
     'values: null-basiertes Array mit Werteliste n = ubound(values)+1)
     'k: Anzahl der Werte in einer Kombination
     'Ausgabe in den Output_kanal
 
     On Error GoTo fehler
     NueberK_Output = False
 
     Dim indices%()
     ReDim indices%(k - 1)
     indices(0) = -1
 
     Dim anz&
     anz = CLng(NueberK(UBound(values) + 1, k))
     If anz = -1 Then Exit Function
 
     ReDim kombi(k - 1) As Integer
 
     Dim i&, j%, l%, freq&
 
     For i = 1 To anz
        NextIndex indices, UBound(values) + 1
 
        'aktuelle Kombination aus Indices ermitteln
        For j = 0 To UBound(kombi)
            kombi(j) = values(indices(j))
        Next j
 
        'Häufigkeit dieser Kombi in den Gruppen zählen
        freq = 0
        'Schleife über Wertelisten in den Gruppen
        'Array: Kombis enthält Gruppen
        For j = 1 To UBound(kombis)
            If ContainsAll(kombis(j).V1, kombi) Then freq = freq + 1
        Next j
 
        If freq > 0 Then
           'Kombination und Häufigkeit ausgeben
           For j = 0 To k - 1
              Print #kanal_out, values(indices(j));
           Next j
 
           Print #kanal_out, "  F = " & CStr(freq)
        End If
     Next i
 
     NueberK_Output = True
     Exit Function
 
fehler:
 
End Function
 
 
Private Function ContainsAll(total() As Integer, kombi() As Integer) As Boolean
 
    'Sind alle Kombi-Werte in Total enthalten ?
 
    ContainsAll = False
 
    Dim i%, k%, found As Boolean
 
    For k = 0 To UBound(kombi)
       found = False
       For i = 1 To UBound(total)
          If total(i) = kombi(k) Then found = True: Exit For
       Next i
       If Not found Then Exit Function
    Next k
 
    ContainsAll = True
End Function

   'Typen-Deklarationen wie bisher 
 
   'Daten-Liste lesen (wie bisher)
   ReadLines "C:\Daten\input.txt"
 
   'Liste der Gruppen erstellen (incl. Wertearray für jede Gruppe)
   'wie bisher 
   SetLinesToKombis
 
   Dim fn$: fn = "C:\daten\output_neu.txt"
 
   'Werteliste erstellen (1-104, nullbasiert)
   Dim values%(103), i%
   For i = 0 To 103
       values(i) = i + 1
   Next i
 
   '2er bis 4er Kombis durchgehen und Häufigkeit ausgeben
   Wertekombinationen_ausgeben fn, values, 2, 4
 
   'bisheriger rest entfällt

Zitat:

Buh. Die für Deine Zwecke angepasste Routine "Nueberk_Output" steht hier

Private Sub SortKombiGroupsList()
 
   'nach Häufigkeiten (= Anzahl Gruppen) fallend sortieren
   Dim i%, k%, f As Freq
   For i = 1 To UBound(Freqs) - 1
      For k = i + 1 To UBound(Freqs)
         If UBound(Freqs(i).groups) < UBound(Freqs(k).groups) Then
            f = Freqs(i)
            Freqs(i) = Freqs(k)
            Freqs(k) = f
         End If
      Next k
   Next i
End Sub

Zitat:

Ergebnis: output_neu.txt mit rund 54 mb wurde angelegt rund 2,3 Mio Zeilen

Zitat:

Aber - ich kann eigentlich nichts damit anfangen. Weil keine absteigende Sortierung vorhanden ist und weil ich keine Gruppen zu den Kombinationen habe.

Zitat:

ich habe absolut - keine bis ganz wenig Erfahrung in VB Was soll ich machen ... keine Ahnung

    Function NueberK_Output(values() As Integer, k%, kanal_out As Integer) As _
      Boolean
 
        'Liste aller Kombinationen der Werte in Values
 
        'values: null-basiertes Array mit Werteliste n = ubound(values)+1)
        'k: Anzahl der Werte in einer Kombination
        'Ausgabe in den geöffneten Ausgabekanal: kanal_out
 
        On Error GoTo fehler
        NueberK_Output = False
 
        Dim indices%()
        ReDim indices%(k - 1)
        indices(0) = -1
 
        Dim anz&, kombistr$, groups() As Integer
        anz = CLng(NueberK(UBound(values) + 1, k))
        If anz = -1 Then Exit Function
 
        ReDim kombi(k - 1) As Integer
        Dim i&, j%, l%, freq&
        For i = 1 To anz
            NextIndex indices, UBound(values) + 1
 
            'aktuelle Kombination aus Indices ermitteln
            'und AusgabeString erstellen
            kombistr = ""
            For j = 0 To k - 1
               kombi(j) = values(indices(j))
               kombistr = kombistr & CStr(kombi(j))
               If j < k - 1 Then kombistr = kombistr & "-"
            Next j
 
            ReDim groups(10)
            'Häufigkeit dieser Kombi in den Gruppen zählen
            freq = 0
            'Schleife über Werteliste in Gruppen
            For j = 1 To UBound(kombis)
                If ContainsAll(kombis(j).V1, kombi) Then
                   freq = freq + 1
                   If freq > UBound(groups) Then
                      ReDim Preserve groups(UBound(groups) + 10)
                   End If
                   'Gruppe, in der die Kombi auftritt, notieren
                   groups(freq) = kombis(j).Group
                End If
            Next j
 
            If freq > 0 Then
               'jeweils Gruppe, Kombination und Häufigkeit ausgeben
               'aufgebaut als Zeile einer CSV-Datei (Strichpunkte trennen 3 
               ' Felder)
               For j = 1 To freq
                   Print #kanal_out, CStr(groups(j)) & ";" & kombistr & ";" & _
                     CStr(freq)
               Next j
            End If
        Next i
 
        NueberK_Output = True
        Exit Function
 
fehler:
 
    End Function