Option Explicit
 
Private Sub Form_Load()
 
   Dim file As String
   file = "C:\daten\input.txt"
 
   Dim lines() As String
   lines = GetLines(file)
 
   Dim erledigt() As Boolean
   ReDim erledigt(UBound(lines))
 
   'Doppelschleife über die Zeilen
   Dim i As Integer, k As Integer
   Dim line1() As Integer, line2() As Integer
 
   For i = 1 To UBound(lines)
      line1 = GetLine(lines(i))
      If Not erledigt(i) Then
          For k = i + 1 To UBound(lines)
             If Not erledigt(k) Then
                line2 = GetLine(lines(k))
                erledigt(k) = CompareLines(line1, line2)
             End If
          Next k
      End If
   Next i
 
   'Zeilen schreiben
   k = FreeFile
   Open "C:\daten\output.txt" For Output As #k
 
   For i = 1 To UBound(lines)
      If erledigt(i) Then
        Write #k, lines(i)
      End If
   Next i
   Close #k
 
End Sub
 
 
Private Function CountLines(ByVal file As String) As Integer
 
   'Zahl der Zeilen in der Datei
   Dim k As Integer, z As Integer, line As String
   k = FreeFile
   Open file For Input As #k
 
   While Not EOF(k)
      Line Input #1, line
      z = z + 1
   Wend
   Close #k
   CountLines = z
End Function
 
 
Private Function GetLines(ByVal file As String) As String()
 
   'Zeilen in ein Array eintragen
   Dim l As Integer
   l = CountLines(file)
 
   Dim lines() As String
   ReDim lines(l) As String
 
   Dim k As Integer, z As Integer
   k = FreeFile
   Open file For Input As #k
   z = 1
   While Not EOF(k)
      Line Input #1, lines(z)
      z = z + 1
   Wend
   Close #k
   GetLines = lines
End Function
 
 
Private Function GetLine(line As String) As Integer()
 
     'ZeilenString in ein Integer-Array eintragen
 
     Dim parts() As String
     parts = Split(line, ",")
 
     Dim ints() As Integer
     ReDim ints(UBound(parts)) As Integer
     Dim i As Integer
     For i = 0 To UBound(parts)
        ints(i) = CInt(parts(i))
     Next i
     GetLine = ints
End Function
 
 
Private Function CompareLines(line1() As Integer, _
                              line2() As Integer) As Boolean
 
   'Werte in zwei Zeilen vergleichen / Anzahl Übereinstimmungen
   Dim i As Integer, k As Integer, id As Integer
 
   For i = 0 To UBound(line1)
      For k = 0 To UBound(line2)
         If line1(i) = line2(k) Then id = id + 1
      Next k
   Next i
   CompareLines = id > 4
End Function

Dim r1 As Byte
Dim r2 As Byte
Dim r3 As Byte
Dim r4 As Byte
Dim r5 As Byte
Dim r6 As Byte
Dim r7 As Byte
Dim r8 As Byte
Dim r9 As Byte
Dim r10 As Byte
Dim r11 As Byte
Dim r12 As Byte
 
 
'öffne ausgabedatei
Open "C:\daten\output.txt" For Output As #1
 
'öffne eingabedatei
Open "C:\daten\input.txt" For Input As #43
 
 
 
'lese nur einmal 1. und 2. zeile
Input #43, r1, r2, r3, r4, r5, r6
 
Input #43, r7, r8, r9, r10, r11, r12
GoTo sp2
 
 
 
sp1:
'es wird jetzt nur noch jeweils eine zeile gelesen und zwar r7 bis r12!
 
'die letzte gelesene zeile wird nach r1 bis r6 gerettet (also nach oben 
' geschoben)
r1 = r7
r2 = r8
r3 = r9
r4 = r10
r5 = r11
r6 = r12
 
 
'nun kann die zeile gelesen werden
Input #43, r7, r8, r9, r10, r11, r12
 
sp2:
 
 
 
flag1 = 0
 
 
If r1 = r7 Or r1 = r8 Or r1 = r9 Or r1 = r10 Or r1 = r11 Or r1 = r12 Then flag1 _
  = flag1 + 1
If r2 = r7 Or r2 = r8 Or r2 = r9 Or r2 = r10 Or r2 = r11 Or r2 = r12 Then flag1 _
= flag1 + 1
If r3 = r7 Or r3 = r8 Or r3 = r9 Or r3 = r10 Or r3 = r11 Or r3 = r12 Then flag1 _
= flag1 + 1
If r4 = r7 Or r4 = r8 Or r4 = r9 Or r4 = r10 Or r4 = r11 Or r4 = r12 Then flag1 _
= flag1 + 1
If r5 = r7 Or r5 = r8 Or r5 = r9 Or r5 = r10 Or r5 = r11 Or r5 = r12 Then flag1 _
= flag1 + 1
If r6 = r7 Or r6 = r8 Or r6 = r9 Or r6 = r10 Or r6 = r11 Or r6 = r12 Then flag1 _
= flag1 + 1
 
If flag1 = 5 Then Print #1, r7; ","; r8; ","; r9; ","; r10; ","; r11; ","; r12
 
 
 
 
If EOF(43) = False Then GoTo sp1
 
Close #43
Close #1

Private Function CompareLines2(line1() As Integer, _
   line2() As Integer) As String
 
   CompareLines2 = ""
 
   Dim i As Integer, k As Integer, id As Integer
   Dim lineout As String
 
   If CompareLines(line1, line2) Then
      For i = 0 To UBound(line1)
         For k = 0 To UBound(line2)
            If line1(i) = line2(k) Then _
               lineout = lineout & CStr(line1(i)) & ", "
         Next k
      Next i
      If Len(lineout) > 2 Then
         lineout = Left(lineout, Len(lineout) - 2)
      End If
      CompareLines2 = lineout
   End If
End Function
 
 
Private Sub FillOutput()
 
   Dim file As String
   file = "C:\daten\input.txt"
 
   Dim lines() As String
   lines = GetLines(file)
 
   Dim ak As Integer
   ak = FreeFile
   Open "C:\daten\output.txt" For Output As #ak
 
   Dim i As Integer, k As Integer
   Dim line1() As Integer, line2() As Integer
   Dim lineout As String
 
    For i = 1 To UBound(lines)
        line1 = GetLine(lines(i))
        For k = i + 1 To UBound(lines)
            line2 = GetLine(lines(k))
            lineout = CompareLines2(line1, line2)
            If Not lineout = "" Then
               Write #ak, lineout
               'Eventuell hier Exit ????
            End If
        Next k
   Next i
   Close #ak
End Sub

Private Sub FillOutput()
 
CompareLines2(line1() As Integer, _
   line2() As Integer) As String
 
CompareLines2 = ""
 
   Dim i As Integer, k As Integer, id As Integer
   Dim lineout As String
 
   If CompareLines(Line1, line2) Then
      For i = 0 To UBound(Line1)
         For k = 0 To UBound(line2)
            If Line1(i) = line2(k) Then _
               lineout = lineout & CStr(Line1(i)) & ", "
         Next k
      Next i
      If Len(lineout) > 2 Then
         lineout = Left(lineout, Len(lineout) - 2)
      End If
      CompareLines2 = lineout
   End If
 
 
 
 
   Dim file As String
   file = "C:\daten\input.txt"
 
   Dim lines() As String
   lines = GetLines(file)
 
   Dim ak As Integer
   ak = FreeFile
   Open "C:\daten\output.txt" For Output As #ak
 
   Dim i As Integer, k As Integer
   Dim Line1() As Integer, line2() As Integer
   Dim lineout As String
 
    For i = 1 To UBound(lines)
        Line1 = GetLine(lines(i))
        For k = i + 1 To UBound(lines)
            line2 = GetLine(lines(k))
            lineout = CompareLines2(Line1, line2)
            If Not lineout = "" Then
               Write #ak, lineout
               'Eventuell hier Exit ????
            End If
        Next k
   Next i
   Close #ak
End Sub

Option Explicit
 
Private Sub Form_Load()
 
   'Der Aufruf der Routine
   FillOutput
 
End Sub
 
 
Private Function CountLines(ByVal file As String) As Integer
 
   'Diese Funktion zählt die Zahl der Zeilen in der Datei
 
   Dim k As Integer, z As Integer, line As String
   k = FreeFile
   Open file For Input As #k
 
   While Not EOF(k)
      Line Input #k, line
      z = z + 1
   Wend
   Close #k
 
   CountLines = z
End Function
 
 
Private Function GetLines(ByVal file As String) As String()
 
   'Diese Funktion lädt die Zeilen in einer Datei in ein StringArray
 
   Dim l As Integer
   l = CountLines(file) 'Zahl der Zeilen bestimmen
 
   Dim lines() As String
   ReDim lines(l) As String
 
   Dim k As Integer, z As Integer
   k = FreeFile
   Open file For Input As #k
   z = 1
   While Not EOF(k)
      Line Input #k, lines(z)
      z = z + 1
   Wend
 
   Close #k
   GetLines = lines
 
End Function
 
 
Private Function GetLine(line As String) As Integer()
 
     'Dies Funktion zerlegt eine Dateizeile (String) anhand des
     'Feldtrennzeichens , in ein Array von Integern
 
     Dim parts() As String
     parts = Split(line, ",")
 
     Dim ints() As Integer
     ReDim ints(UBound(parts)) As Integer
     Dim i As Integer
     For i = 0 To UBound(parts)
        ints(i) = CInt(parts(i))
     Next i
     GetLine = ints
End Function
 
 
Private Function CompareLines(line1() As Integer, _
         line2() As Integer) As Boolean
 
   'Diese Funktion zählt, wieviele Integerwerte in beiden
   'Arrays (line1, line2) vorkommen und gibt true zurück,
   'wenn mehr als vier Werte identisch sind
 
   Dim i As Integer, k As Integer, id As Integer
 
   For i = 0 To UBound(line1)
      For k = 0 To UBound(line2)
         If line1(i) = line2(k) Then id = id + 1
      Next k
   Next i
   CompareLines = id > 4
End Function
 
 
Private Function CompareLines2(line1() As Integer, _
   line2() As Integer) As String
 
   'Diese Funktion zählt, wieviele Integerwerte in beiden
   'Arrays (line1, line2) vorkommen (CompareLines) und gibt
   'den Wertstring zurück, wenn mehr als vier Werte identisch sind
 
   CompareLines2 = ""
 
   Dim i As Integer, k As Integer, id As Integer
   Dim lineout As String
 
   If CompareLines(line1, line2) Then
      '.... es sind mehr als vier gleiche Werte vorhanden
      For i = 0 To UBound(line1)
         For k = 0 To UBound(line2)
            If line1(i) = line2(k) Then _
              lineout = lineout & CStr(line1(i)) & ", "
         Next k
      Next i
 
      If Len(lineout) > 2 Then
         lineout = Left(lineout, Len(lineout) - 2)
      End If
 
      CompareLines2 = lineout
   End If
End Function
 
 
Private Sub FillOutput()
 
   'Diese Funktion liest die Zeilen einer Datei (6 Integer pro Zeile, getrennt 
   ' durch ,)
   'und gibt für alle paarweisen Zeilenvergleiche, bei denen mehr als
   'vier Werte identisch sind, diejenigen Werte aus, die in beiden Zeilen 
   ' vorkommen
 
   Dim file As String
   file = "C:\daten\input.txt"
 
   'Alle Zeilen lesen
   Dim lines() As String
   lines = GetLines(file)
 
   'Ausgabe öffnen
   Dim ak As Integer
   ak = FreeFile
   Open "C:\daten\output.txt" For Output As #ak
 
   Dim i As Integer, k As Integer
   Dim line1() As Integer, line2() As Integer
   Dim lineout As String
 
    'Schleife über alle Zeilen(strings)
    For i = 1 To UBound(lines)
        'Werte in Zeile besorgen
        line1 = GetLine(lines(i))
 
        'Schleife über alle Folgezeilen
        For k = i + 1 To UBound(lines)
            line2 = GetLine(lines(k))
            'Zeile i, k vergleichen
            lineout = CompareLines2(line1, line2)
 
            If Not lineout = "" Then
               'Falls mehr als vier identische Werte ...
               Write #ak, lineout
            End If
        Next k
   Next i
   Close #ak
End Sub

If line1(i) = line2(k) Then _
   lineout = lineout & CStr(line1(i)) & ", "

Zitat:

Oder willst Du zunächst ermitteln, welche 5er Kombi die größte Häufigkeit in den Datenreihen besitzt und dann im zweiten Schritt Reihen entfernen, in denen diese Kombination auftritt. Aber wie viele nach welchem Auswahl-Kriterium? Ja dieser Ansatz ist gemeint Aber nicht welche 5er Kombi die größte Häufigkeit in den Datenreihen besitzt sonder 1. wie oft kommt welche 5er Kombi in der jetzigen output.txt vor 2. Auswahl-Kriterium = behalte nur noch die, die 2-3 mal vorhanden sind schreibe diese dann in die output-ende.txt (jede natürlich nur 1x nicht 2-3 mal reinschreiben) LG Angelina

Private Function CompareLines3(line1%(), line2%(), outvalues%()) As Boolean
 
    'Die Routine prüft, ob in beiden Zeilen (line1, line2)
    '5 identische Werte vorhanden sind und 
    'gibt diese Werte zurück (outvalues)
 
    Dim i%, k%, id%
 
    ReDim outvalues(UBound(line1))
    id = -1
    For i = 0 To UBound(line1)
       For k = 0 To UBound(line2)
          If line1(i) = line2(k) Then
             id = id + 1
             outvalues(id) = line1(i)
          End If
       Next k
    Next i
 
    CompareLines3 = (id = 4)
End Function
 
 
Private Sub RegisterEntry(entry%(), register%(), frequency%())
 
    'Die Routine prüft, ob eine sortierte 5er Folge (Entry)
    'bereits im Register vorhanden ist und zählt die
    'Häufigkeit (in Frequency)
 
    Dim i%, k%, l%, vorhanden As Boolean
 
    For i = 1 To UBound(register, 2)
       vorhanden = True
       'Ist der Eintrag schon im Register?
       For k = 0 To UBound(register, 1)
           If Not entry(k) = register(k, i) Then
              vorhanden = False: Exit For
           End If
       Next k
 
       If vorhanden Then
          'Eintrag bereits vorhanden
          frequency(i) = frequency(i) + 1
          Exit Sub
       End If
    Next i
 
    l = UBound(register, 2)
 
    'Register für neuen Eintrag  verlängern
    ReDim Preserve register(UBound(register, 1), l + 1)
    ReDim Preserve frequency(l + 1)
 
    'neuen Eintrag notieren
    frequency(l + 1) = 1
    For k = 0 To UBound(register, 1)
       register(k, l + 1) = entry(k)
    Next k
 
End Sub
 
 
Private Sub CombiFrequencies()
 
   Dim file As String
   file = "C:\daten\angelina.txt"
 
  'Alle Zeilen lesen
   Dim lines() As String
   lines = GetLines(file)
 
   Dim i%, k%
   Dim line1%(), line2%(), outvalues%()
   Dim register%(), frequency%()
   ReDim register(4, 0)
 
   'Zeilen paarweise miteinander vergleichen
   For i = 1 To UBound(lines) - 1
      line1 = GetLine(lines(i))
      For k = i + 1 To UBound(lines)
          line2 = GetLine(lines(k))
          'Vergleichen
          If CompareLines3(line1, line2, outvalues) Then
             'bei gleicher 5er Folge: Register füllen
             RegisterEntry outvalues, register, frequency
          End If
      Next k
   Next i
 
   'Ausgabedatei füllen
   Dim ak%
   ak = FreeFile
   Open "C:\daten\output.txt" For Output As #ak
 
   For i = 1 To UBound(frequency)
      'Ab 2er Vorkommen einer 5erFolge: ausgeben
      If frequency(i) > 1 Then
 
         For k = 0 To UBound(register, 1)
            If k < UBound(register, 1) Then
               Print #ak, register(k, i) & ", ";
            Else
               Print #ak, register(k, i)
            End If
         Next k
      End If      
  Next i
 
  Close #ak
 
End Sub

   For i = 1 To UBound(frequency)
      'Ab 2er Vorkommen einer 5erFolge: ausgeben
      If frequency(i) = 2 Or frequency(i) = 3 Then
 
         For k = 0 To UBound(register, 1)
            If k < UBound(register, 1) Then
               Print #ak, CStr(register(k, i)) & ", ";
            Else
               Print #ak, CStr(register(k, i))
            End If
         Next k
      End If            
  Next i

Public Sub TextDatei2HTML(ByVal filename As String, _
    Optional ByVal Titel As String)
 
    Dim Text As String, sTmpLine As String
    Dim F As Integer
    Dim sHeader As String
    Dim OutFileName As String
 
    'Dateiinhalt lesen
    F = FreeFile
    Open filename For Input As #F
    Do
       Line Input #F, sTmpLine
       Text = Text & sTmpLine & "/br/" & vbCrLf
    Loop Until EOF(F)
    Close #F
 
    ' HTML-Header
    If Titel = "" Then Titel = "Text2HTML"
    sHeader = "<HEAD><TITLE>" & Titel & "</TITLE></HEAD>"
 
    OutFileName = filename & ".HTM"
 
    ' HTML-Datei speichern
    F = FreeFile
    Open OutFileName For Output As #F
    Print #F, "<HTML>"
    Print #F, sHeader
    Print #F, "<BODY>"
    Print #F, Text
    Print #F, "</BODY>"
    Print #F, "</HTML>"
    Close #F
End Sub

1 , 4 , 6 , 14 , 15 , 38 /br/ 1 , 4 , 6 , 14 , 18 , 35 /br/ 1 , 4 , 6 , 14 , 18 _
  , 40 /br/ 1 , 4 , 6 , 14 , 27 , 36 /br/ 1 , 4 , 6 , 14 , 27 , 40 /br/ 1 , 4 , _
  6 , 14 , 29 , 38 /br/ 1 , 4 , 6 , 14 , 35 , 36 /br/ 1 , 4 , 6 , 14 , 36 , 40 _
  /br/ 1 , 4 , 6 , 15 , 20 , 38 /br/ 1 , 4 , 6 , 15 , 38 , 39 /br/ 1 , 4 , 6 , _
  15 , 38 , 46 /br/ 1 , 4 , 6 , 18 , 20 , 35 /br/ 1 , 4 , 6 , 18 , 20 , 40 /br/ _
  1 , 4 , 6 , 18 , 35 , 39 /br/ 1 , 4 , 6 , 18 , 35 , 46 /br/ 1 , 4 , 6 , 18 , _
  39 , 40 /br/ 1 , 4 , 6 , 18 , 40 , 46 /br/ 1 , 4 , 6 , 20 , 27 , 36 /br/ 1 , _
  4 , 6 , 20 , 27 , 40 /br/ 1 , 4 , 6 , 20 , 29 , 38 /br/ 1 , 4 , 6 , 20 , 35 , _
  36 /br/ 1 , 4 , 6 , 20 , 36 , 40 /br/ 1 , 4 , 6 , 27 , 36 , 39 /br/ 1 , 4 , 6 _
  , 27 , 36 , 46 /br/ 1 , 4 , 6 , 27 , 39 , 40 /br/ 1 , 4 , 6 , 27 , 40 , 46 _
  /br/ 1 , 4 , 6 , 29 , 38 , 39 /br/ 1 , 4 , 6 , 29 , 38 , 46 /br/ 1 , 4 , 6 , _
  35 , 36 , 39 /br/ 1 , 4 , 6 , 35 , 36 , 46 /br/

Zitat:

zu 1.) Der Code ist nicht optimiert, z.B. kann der häufige Aufruf der Konvertierung durch GetLine im Rahmen einer Vorverarbeitung der geladenen Zeilen reduziert werden. (Die 820 Zeilen in der Angelina.txt werden innerhalb von ca. 5 Sekunden auf einem handelsüblichen PC verarbeitet.) zu 2.) Die 335790 paarweisen Vergleiche ergeben 5090 mal eine doppelt vorkommende 5er Folge. Die Zahl der unterscheidbaren Folgen (im Register) beträgt 1650, davon sind 520 Folgen 2 oder 3 mal enthalten.

Public Sub NumberFrequency _
    (ByVal Filename, ByVal start As Integer, ByVal ende As Integer)
 
   Dim ik As Integer, ak As Integer  'Kanäle
   Dim line As String, fields() As String 'Dateizeile
   Dim dateval As Integer  'Datum in Zeile
 
   Dim i As Integer, k As Integer 'Loopings
   Dim z As Integer ' Ziehungszähler
 
   'Zeit-Intervall: Grenzen sicher stellen
   If ende < start Then
       i = start
       start = ende
       ende = i
   End If
 
   'Zählerregister
   Dim frequency(49)
 
   ik = FreeFile
 
   Open Filename For Input As #ik
 
   While Not EOF(ik)
      Line Input #ik, line
      '(numerische) Felder in einer Zeile
      fields = Split(line, " ")
      'Check
      If Not UBound(fields) = 7 Then Stop
      'Datumsfeld wandeln
      dateval = CInt(fields(0))
      'Zeitfilter setzen
      If dateval >= start And dateval <= ende Then
         'Häufigkeitszähler füllen
         For i = 1 To 7
            frequency(CInt(fields(i))) = frequency(CInt(fields(i))) + 1
         Next i
 
         z = z + 1
      End If
 
   Wend
 
   Close #ik
 
   ak = FreeFile
   Open "C:\daten\numberfrequencies.txt" For Output As #ik
 
   Print #ak, Filename
   Print #ak, "Start: "; start
   Print #ak, "Ende: "; ende
   Print #ak, "Ziehungen: "; z
 
   For i = 1 To 49
      Print #ak, i, frequency(i)
   Next i
 
   Close #ak
 
End Sub

   Call NumberFrequency("C:\daten\sa-ziehungen.txt", 3050, 2999)

    Printer.Print i, frequency(i)

Print #ak, Filename
   Print #ak, "Start: "; start
   Print #ak, "Ende: "; ende
   Print #ak, "Ziehungen: "; z
 
   For i = 1 To 49
      Print #ak, i, frequency(i)
   Next i
 
   Close #ak

Print #ak, Filename
   Print #ak, "Start: "; start
   Print #ak, "Ende: "; ende
   Print #ak, "Ziehungen: "; z
 
   For i = 1 To 49
      Printer.Print i, frequency(i)
      Print #ak, i, frequency(i)
   Next i
 
   Close #ak

   If frequency(i) = 0 Then frequency(i) = " 0"
      Print #ak, i, frequency(i)
   Next i
 
   Close #ak

'Zählerregister
Dim frequency(49) as Integer

 
 2 
 2 
 2 
 2 
 1 
 1 
 1 
 1 
 1 
 1 
 2 
 2 
 2 
 2 
 2 
 2 
 2 
 2 
 2 
 1 
 1 
 1 
 1 
 1 
 1 
 1 
 1

Sub HäufigkeitSeitLetztemWertwechsel _
    (ByVal file_in As String, ByVal file_out As String)
 
   Dim ik As Integer, ak As Integer 'Kanäle
   Dim number1 As Integer, number2 As Integer 'Vergleich
   Dim i As Integer 'Loop
   Dim c As Integer 'Zähler
   Dim n As Integer 'gezählter Wert nach letztem Wechsel
 
   ik = FreeFile
   Open file_in For Input As #ik
 
   Input #ik, number1
   c = 1: n = number1
 
   While Not EOF(ik)
      Input #ik, number2
      If Not number1 = number2 Then
         c = 1: n = number2 'Wert wechselt
      Else
         c = c + 1 'Wert wechselt nicht/zählen
      End If
 
      number1 = number2 'für nächsten Vergleich
   Wend
 
   Close #ik
 
   'Ausgabedatei füllen
   ak = FreeFile
   Open file_out For Output As #ak
 
   For i = 1 To c
      Print #ak, n;
   Next i
   Print #ak, "  Laufzeit: "; c
 
   Close #ak
 
End Sub

Call HäufigkeitSeitLetztemWertwechsel

Call HäufigkeitSeitLetztemWertwechsel("C:\daten\suche.txt", _
"C:\daten\LetzteFolge.txt")

Zitat:

Du kannst die Datei durchlaufen und bei jedem Wechsel von zwei aufeinander folgenden Werten den neuen Wert notieren und damit anfangen, ihn zu zählen - falls ich das richtig verstanden habe.

Zitat:

Call HäufigkeitSeitLetztemWertwechsel("C:\daten\suche.txt", _ "C:\daten\LetzteFolge.txt")

Zitat:

Was steht in Suche.txt drin? Gibt es diese Datei auch 49x? Oder stehen Zahlenfolgen mit Werten 1 bis 49 in der Datei suche.txt und Du willst für jede Zahl die Länge der letzten Folge dieser Zahl - auch wenn das nicht die absolut letzte Folge in der Datei ist?

Zitat:

das man letztendlich erfährt wann ein Wechsel erfolgt. Also wenn z.B. 8x die eins in Folge war kommt ein Wechsel zu 2 oder was auch immer. Oder wenn die zwei 3x in Folge war kommt ein Wechsel zu 1 oder was auch immer. Wann kommt ein Wechsel zu welcher Zahl - Immer gesehen von nun Dateianfang bis Dateiende. Nicht wie vorher von unten nach oben.

Zitat:

Vielleicht solltest Du versuchen, Deinem Opa klar zu machen, daß er gegen einen Zufallsprozeß nicht "anrechnen" kann.

Zitat:

Wenn er sich unbedingt der "Faszination" des Lottospielens hingeben will, sollte er sich einer Tippgemeinschaft anschließen, ... Das senkt zwar die Chancen auf einen hohen Gewinn, verbessert aber die Chancen für kleine Zwischengewinne. Gut gemacht, kann man langfristig dadurch etwa 20% des Einsatzes zurückgewinnen.

 9 
 9 
 9 
 9 
 9 
 10 
 11 
 11 
 10 
 10 
 9 
 10 
 10 
 10 
 10 
 10 
 10 
 10 
 10 
 9 
 8 
 8 
 9 
 10 
 10 
 10 
 10 
 9 
 9 
 9 
 9 
 9 
 9 
 9 
 8 
 7 
 7 
 7 
 6 
 6 
 6 
 6 
 6 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 5 
 6 
 .
 .
 . usw.

Option Explicit
 
'Datentyp für Registrierung eines Zahlenübergangs
Private Type Wechsel
    vorher As Integer
    nachher As Integer
    anzahl As Integer
End Type
 
'Register der Übergangshäufigkeiten    
Private register() As Wechsel
 
'Verwaltung des Registers    
Private Sub RegistriereWechsel(ByVal vorher As Integer, _
                               ByVal nachher As Integer)
 
   Dim i As Integer, gefunden As Boolean
 
   gefunden = False
   For i = 1 To UBound(register)
      With register(i)
         If .vorher = vorher And .nachher = nachher Then
             'vorhandener Wechsel / Zählen
             .anzahl = .anzahl + 1
             gefunden = True: Exit For
         End If
      End With
   Next i
 
   If Not gefunden Then
       'neuer Wechsel
       i = UBound(register) + 1
       ReDim Preserve register(i)
       Dim w As Wechsel
       w.vorher = vorher
       w.nachher = nachher
       w.anzahl = 1
       register(i) = w
  End If
 
 
End Sub
 
 
Private Function NumLen(ByVal number As Integer, _
                       minlen As Integer) As String
 
    'Formatierung der Ausgabe
 
    NumLen = CStr(number)
    While Len(NumLen) < minlen
        NumLen = " " & NumLen
    Wend
 
End Function
 
 
Private Sub Form_Load()
    ReDim register(0)
 
    Dim ik%, ak%, i%, z%, w%
    Dim number1%, number2%
 
    ik = FreeFile
    Open "C:\daten\suchen-neu.txt" For Input As #ik
 
    'Datei lesen
    Input #ik, number1
 
    While Not EOF(ik)
        Input #ik, number2
        If Not number1 = number2 Then
           RegistriereWechsel number1, number2
           w = w + 1
        End If
        number1 = number2
        z = z + 1
    Wend
    Close #ik
 
    ak = FreeFile
 
    'Ausgabe füllen
    Open "C:\daten\zahlenübergänge.txt" For Output As #ak
 
    Print #ak, "Anzahl Zahlen: "; z
    Print #ak, "Anzahl Übergänge: "; w
    Print #ak, ""
 
    For i = 1 To UBound(register)
        With register(i)
            Print #ak, "Nach "; NumLen(.vorher, 3); " folgt "; _
            NumLen(.nachher, 3); " = "; NumLen(.anzahl, 3)
        End With
    Next i
 
    Close #ak
 
End Sub

Private Sub Form_Load()

Sub Zahlenfolge()

Option Explicit
 
'Datentyp für Registrierung eines Zahlenübergangs
Private Type Wechsel
 
    vorher As Integer
    nachher As Integer
    anzahl As Integer
End Type
 
 
'Register der Übergangshäufigkeiten
Private register() As Wechsel
 
'Verwaltung des Registers
Private Sub RegistriereWechsel(ByVal vorher As Integer, _
                               ByVal nachher As Integer)
usw.
.
.
.

 9 
 9 
 9 
 9 
 9 
 10 
 11 
 11 
 10 
 10 
 9 
 10 
 10 
 10 
 10 
 10 
 10 
 10 
 10

Option Explicit
 
Private Type Wechsel2
    vorher As Integer
    freqvorher As Integer
    nachher As Integer
    anzahl As Integer
End Type
 
Private register() As Wechsel2
 
Private Sub RegistriereWechsel(ByVal vorher As Integer, _
                               ByVal freqvorher As Integer, _
                               ByVal nachher As Integer)
 
   Dim i As Integer, gefunden As Boolean
 
   gefunden = False
   For i = 1 To UBound(register)
      With register(i)
         If .vorher = vorher And .nachher = nachher _
            And .freqvorher = freqvorher Then
             'vorhandener Wechsel / Zählen
             .anzahl = .anzahl + 1
             gefunden = True: Exit For
         End If
      End With
   Next i
 
   If Not gefunden Then
       'neuer Wechsel
       i = UBound(register) + 1
       ReDim Preserve register(i)
       Dim w As Wechsel2
       w.vorher = vorher
       w.freqvorher = freqvorher
       w.nachher = nachher
       w.anzahl = 1
       register(i) = w
  End If
 
 
End Sub
 
Private Function NumLen(ByVal number As Integer, _
                       minlen As Integer) As String
 
    'Formatierung der Ausgabe
 
    NumLen = CStr(number)
    While Len(NumLen) < minlen
        NumLen = " " & NumLen
    Wend
 
End Function
 
 
Private Sub Form_Load()
    ReDim register(0)
 
    Dim ik%, ak%, i%, z%, w%
    Dim fv% 'Frequenz der Folge vor dem Wechsel zählen
    Dim number1%, number2%
 
    ik = FreeFile
    Open "C:\daten\suchen-neu.txt" For Input As #ik
 
    'Datei lesen
    Input #ik, number1
 
    While Not EOF(ik)
        Input #ik, number2
        fv = fv + 1
        If Not number1 = number2 Then
           RegistriereWechsel number1, fv, number2
           w = w + 1
           fv = 0
        End If
        number1 = number2
        z = z + 1
    Wend
    Close #ik
 
    ak = FreeFile
 
    QuickSort register, 1, UBound(register)
 
    'Ausgabe füllen
    Open "C:\daten\zahlenübergänge2.txt" For Output As #ak
 
    Print #ak, "Anzahl Zahlen: "; z
    Print #ak, "Anzahl Übergänge: "; w
    Print #ak, ""
 
    For i = 1 To UBound(register)
        With register(i)
            Print #ak, "Nach "; NumLen(.vorher, 3); " folgt "; _
            NumLen(.nachher, 3); " = "; NumLen(.anzahl, 3); "x, wenn "; _
            NumLen(.vorher, 3) & " = " & NumLen(.freqvorher, 3) & "x bestanden" & _
            "hat"
        End With
    Next i
 
    Close #ak
 
End Sub
 
 
Private Sub QuickSort(Sort() As Wechsel2, ByVal Start%, ByVal Ende%)
 
  Dim i%, j%
  Dim h As Wechsel2
  Dim x As Wechsel2
 
  i = Start: j = Ende
  x = Sort((Start + Ende) / 2)
 
  ' Array aufteilen
  Do
 
    While comparewechsel(Sort(i), x) < 0: i = i + 1: Wend
    While comparewechsel(Sort(j), x) > 0: j = j - 1: Wend
 
    If (i <= j) Then
      ' Wertepaare miteinander tauschen
      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 comparewechsel(w1 As Wechsel2, w2 As Wechsel2) As Integer
    comparewechsel = 1
    If w1.vorher > w2.vorher Then Exit Function
    If w1.vorher = w2.vorher And _
       w1.nachher > w2.nachher Then Exit Function
    comparewechsel = 0
    If w1.vorher = w2.vorher And _
       w1.nachher = w2.nachher Then Exit Function
    comparewechsel = -1
End Function

Public Sub NumberFrequency _
    (ByVal Filename, ByVal start As Integer, ByVal ende As Integer)
 
   Dim ik As Integer, ak As Integer  'Kanäle
   Dim line As String, fields() As String 'Dateizeile
   Dim dateval As Integer  'Datum in Zeile
 
   Dim i As Integer, k As Integer 'Loopings
   Dim z As Integer ' Ziehungszähler
 
   'Zeit-Intervall: Grenzen sicher stellen
   If ende < start Then
       i = start
       start = ende
       ende = i
   End If
 
   'Zählerregister
Dim frequency(49) as Integer
 
   ik = FreeFile
 
   Open Filename For Input As #ik
 
   While Not EOF(ik)
      Line Input #ik, line
      '(numerische) Felder in einer Zeile
      fields = Split(line, " ")
      'Check
      If Not UBound(fields) = 7 Then Stop
      'Datumsfeld wandeln
      dateval = CInt(fields(0))
      'Zeitfilter setzen
      If dateval >= start And dateval <= ende Then
         'Häufigkeitszähler füllen
         For i = 1 To 7
            frequency(CInt(fields(i))) = frequency(CInt(fields(i))) + 1
         Next i
 
         z = z + 1
      End If
 
   Wend
 
   Close #ik
 
   ak = FreeFile
   Open "C:\daten\numberfrequencies.txt" For Output As #ik
 
   Print #ak, Filename
   Print #ak, "Start: "; start
   Print #ak, "Ende: "; ende
   Print #ak, "Ziehungen: "; z
 
   For i = 1 To 49
      Print #ak, i, frequency(i)
   Next i
 
   Close #ak
 
End Sub
 
 
Aufruf der Routine:
 
   Call NumberFrequency("C:\daten\sa-ziehungen.txt", 3050, 2999)

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

Call NumberDistance("C:\daten\sa-ziehungen.txt", 3052, 2999, _
  "C:\daten\sa-Ergebnis.txt")

Private Sub QuickSort(Sort() As NumberDistanceType, ByVal Start%, ByVal Ende%)

Private Sub Form_Load()
 
    Call NumberDistance("C:\daten\sa-ziehungen.txt", 3052, 2999, _
                        "C:\daten\sa-Ergebnis.txt")
 
End Sub

Option Explicit
 
Private Type NumberDistanceType
    number As Integer
    Position As Integer
    Distance As Integer
End Type
 
Dim NumberRegister() As NumberDistanceType
 
 
Private Sub Form_Load()
 
    Call NumberDistance("C:\daten\sa-ziehungen.txt", 3052, 2999, _
                        "C:\daten\sa-Ergebnis.txt")
 
End Sub
 
'usw.

Dim out As Integer
Dim i1%, i2%, i3%, i4%, i5%, i6%
out = FreeFile
 
Open ("C:\daten\6er-Kombis.txt") For Output As out
 
'Die Motorzahlen als Feld erstellen
Dim mot(13983816, 6) As Integer
zw = 0
For i1 = 1 To 44
s21 = i1 + 1
For i2 = s21 To 45
s31 = i2 + 1
For i3 = s31 To 46
s41 = i3 + 1
For i4 = s41 To 47
s51 = i4 + 1
For i5 = s51 To 48
s61 = i5 + 1
For i6 = s61 To 49
 
 
 
zw = zw + 1
mot(zw, 1) = i1
mot(zw, 2) = i2
mot(zw, 3) = i3
mot(zw, 4) = i4
mot(zw, 5) = i5
mot(zw, 6) = i6
 
ff:
Next i6, i5, i4, i3, i2, i1
 
 
zw = 0
mot:
zw = zw + 1
If mot(zw, 1) = 0 Then GoTo motaus
i1 = mot(zw, 1)
i2 = mot(zw, 2)
i3 = mot(zw, 3)
i4 = mot(zw, 4)
i5 = mot(zw, 5)
i6 = mot(zw, 6)
 
Print #out, i1; ","; i2; ","; i3; ","; i4; ","; i5; ","; i6
 
 
GoTo mot
 
motaus:
 
Close #out

Option Explicit
 
Private Sub Form_Load()
 
'49 Gewichte einlesen
Dim z(1 To 49) As Integer, ii%
Dim ik%: ik = FreeFile
Open "C:\daten\gewichte.txt" For Input As #ik
For ii = 1 To 49
    Input #ik, z(ii)
Next ii
Close #ik
 
'Grenzen der gültigen Quersumme hier angeben
Const qs_min% = 50
Const qs_max% = 51
 
Dim ak%: ak = FreeFile
Open "C:\daten\SechserFolgen.txt" For Output As #ak
 
 
Dim i%, j%, k%, l%, m%, n%
Dim qs%, zz As Long, sum As Long
Dim freq(1 To 49) As Long
For i = 1 To 44
   For j = i + 1 To 45
      For k = j + 1 To 46
         For l = k + 1 To 47
             For m = l + 1 To 48
                For n = m + 1 To 49
                   'Summe der Gewichte
                   qs = z(i) + z(j) + z(k) + z(l)
                   qs = qs + z(m) + z(n)
                   zz = zz + 1
 
                   'Gewichte-Summe im gültigen Bereich ?
                   If qs >= qs_min And qs <= qs_max Then
 
                      'Reihe ausgeben 
                      Print #ak, i, j, k, l, m, n
 
                      'Häufigkeit der Zahlen
                      freq(i) = freq(i) + 1
                      freq(j) = freq(j) + 1
                      freq(k) = freq(k) + 1
                      freq(l) = freq(l) + 1
                      freq(m) = freq(m) + 1
                      freq(n) = freq(n) + 1
 
                      'Ausgegebene Reihen
                      sum = sum + 1
                   End If
Next n, m, l, k, j, i
 
Close #ak
 
End Sub

 'Häufigkeit der Zahlen
                      freq(i) = freq(i) + 1
                      freq(j) = freq(j) + 1
                      freq(k) = freq(k) + 1
                      freq(l) = freq(l) + 1
                      freq(m) = freq(m) + 1
                      freq(n) = freq(n) + 1
 
                      'Ausgegebene Reihen
                      sum = sum + 1
                   End If
Next n, m, l, k, j, i
 
  Print #ak, ""
  Print #ak, "Anzahl 6er-Kombis = "; sum
  Print #ak, ""
  Print #ak, "Zahl 01 = "; freq(1)
  Print #ak, "Zahl 02 = "; freq(2)
  Print #ak, "Zahl 03 = "; freq(3)
  Print #ak, "Zahl 04 = "; freq(4)
  Print #ak, "Zahl 05 = "; freq(5)
  Print #ak, "Zahl 06 = "; freq(6)
  Print #ak, "Zahl 07 = "; freq(7)
  Print #ak, "Zahl 08 = "; freq(8)
  Print #ak, "Zahl 09 = "; freq(9)
  Print #ak, "Zahl 10 = "; freq(10)
  Print #ak, "Zahl 11 = "; freq(11)
  Print #ak, "Zahl 12 = "; freq(12)
  Print #ak, "Zahl 13 = "; freq(13)
  Print #ak, "Zahl 14 = "; freq(14)
  Print #ak, "Zahl 15 = "; freq(15)
  Print #ak, "Zahl 16 = "; freq(16)
  Print #ak, "Zahl 17 = "; freq(17)
  Print #ak, "Zahl 18 = "; freq(18)
  Print #ak, "Zahl 19 = "; freq(19)
  Print #ak, "Zahl 20 = "; freq(20)
  Print #ak, "Zahl 21 = "; freq(21)
  Print #ak, "Zahl 22 = "; freq(22)
  Print #ak, "Zahl 23 = "; freq(23)
  Print #ak, "Zahl 24 = "; freq(24)
  Print #ak, "Zahl 25 = "; freq(25)
  Print #ak, "Zahl 26 = "; freq(26)
  Print #ak, "Zahl 27 = "; freq(27)
  Print #ak, "Zahl 28 = "; freq(28)
  Print #ak, "Zahl 29 = "; freq(29)
  Print #ak, "Zahl 30 = "; freq(30)
  Print #ak, "Zahl 31 = "; freq(31)
  Print #ak, "Zahl 32 = "; freq(32)
  Print #ak, "Zahl 33 = "; freq(33)
  Print #ak, "Zahl 34 = "; freq(34)
  Print #ak, "Zahl 35 = "; freq(35)
  Print #ak, "Zahl 36 = "; freq(36)
  Print #ak, "Zahl 37 = "; freq(37)
  Print #ak, "Zahl 38 = "; freq(38)
  Print #ak, "Zahl 39 = "; freq(39)
  Print #ak, "Zahl 40 = "; freq(40)
  Print #ak, "Zahl 41 = "; freq(41)
  Print #ak, "Zahl 42 = "; freq(42)
  Print #ak, "Zahl 43 = "; freq(43)
  Print #ak, "Zahl 44 = "; freq(44)
  Print #ak, "Zahl 45 = "; freq(45)
  Print #ak, "Zahl 46 = "; freq(46)
  Print #ak, "Zahl 47 = "; freq(47)
  Print #ak, "Zahl 48 = "; freq(48)
  Print #ak, "Zahl 49 = "; freq(49)
 
Close #ak