Public Sub CreateSeries(ByVal file_weights$, ByVal file_areas$, _
                         ByVal file_seriesout$, ByVal file_freqout$)
 
    Dim weights%(), musts%()
    Call ReadWeights(file_weights, weights, musts)
 
    Dim ug%(), og%()
    Call ReadAreas(file_areas, ug, og)
 
    Dim i%, j%, k%, l%, m%, n%
    Dim sum As Long, wsum%
    Dim freq(1 To 49) As Long
    Dim seriesweights%()
    Dim ak%: ak = FreeFile
    Open file_seriesout For Output As #ak
 
    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
                       seriesweights = GetWeights(weights, i, j, k, l, m, n, _
                         wsum)
 
 
                       If InArea(ug(), og(), wsum) Then
                          'Gewichte-Summe im gültigen Bereich
 
                          If ContainsMust(seriesweights, musts) And _
                             UniqueValues(seriesweights) Then
 
                             Print #ak, i; j; k; l; m; n
 
                             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
                             sum = sum + 1
                          End If
                       End If
    Next n, m, l, k, j, i
 
    Close #ak
 
    ak = FreeFile
    Open file_freqout For Output As #ak
 
    Print #ak, "Gewichte in: "; file_weights
    Print #ak, "Bereiche in: "; file_areas
    Print #ak, "Serien in:   "; file_seriesout
    Print #ak, "Ausgegebene Serien: "; sum
    Print #ak, "Zahlen-Häufigkeiten in Serien: "
 
    For i = 1 To 49
        Print #ak, "Zahl: " & CStr(i); " --> "; freq(i)
    Next i
 
    Close #ak
End Sub
 
 
Private Sub ReadWeights(ByVal filename$, ByRef weights%(), ByRef musts%())
 
    Dim i%, k%, ik%, line$
 
    ReDim weights(1 To 49)
    ReDim musts(0)
 
    ik = FreeFile
    Open filename For Input As ik
 
    For i = 1 To 49
        Line Input #ik, line
        weights(i) = Val(line)
        If InStr(line, "*") > 0 Then
           k = UBound(musts) + 1
           ReDim Preserve musts(k)
           musts(k) = weights(i)
        End If
    Next i
    Close #ik
 
End Sub
 
Private Sub ReadAreas _
    (ByVal filename$, ByRef ug() As Integer, ByRef og() As Integer)
 
    Dim i%, k%, ik%, line$
    ReDim ug(0), og(0)
    Dim area() As String
    ik = FreeFile
    Open filename For Input As ik
    While Not EOF(ik)
        Line Input #ik, line
        area = Split(line, ",")
        k = UBound(ug) + 1
        ReDim Preserve ug(k)
        ReDim Preserve og(k)
        ug(k) = Val(area(0))
        og(k) = Val(area(1))
    Wend
    Close #ik
 
End Sub
 
 
Private Function GetWeights _
   (weights%(), i%, j%, k%, l%, m%, n%, ByRef wsum%) As Integer()
 
   Dim ii%
   'Array mit den Gewichten der Zahlenfolge erstellen
   Dim g(1 To 6) As Integer
   g(1) = weights(i): g(2) = weights(j): g(3) = weights(k)
   g(4) = weights(l): g(5) = weights(m): g(6) = weights(n)
   wsum = 0
   For ii = 1 To 6
      wsum = wsum + g(ii)
   Next ii
   GetWeights = g
End Function
 
 
Private Function ContainsMust(seriesweights%(), musts%()) As Boolean
 
    Dim ii%, kk%
    ContainsMust = True
    If UBound(musts) = 0 Then Exit Function
    For ii = 1 To UBound(musts)
       For kk = 1 To 6
          If musts(ii) = seriesweights(kk) Then Exit Function
       Next kk
    Next ii
 
    ContainsMust = False
End Function
 
 
Private Function UniqueValues(seriesweights%()) As Boolean
 
   Dim ii%, kk%
 
   UniqueValues = False
   For ii = 1 To 5
      For kk = ii + 1 To 6
         'doppeltes Gewicht gefunden
         If seriesweights(ii) = seriesweights(kk) Then Exit Function
      Next kk
   Next ii
   UniqueValues = True
End Function
 
 
Private Function InArea(ug%(), og%(), gsum%) As Boolean
    Dim i%
    InArea = True
    For i = 1 To UBound(ug)
       If gsum >= ug(i) And gsum <= og(i) Then Exit Function
    Next i
    InArea = False
End Function