Option Explicit
Option Base 1


Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer

Dim g As Integer
Dim a As Integer
Dim e As Integer
Dim p As Integer
Dim b As Integer
Dim L As Double
Dim Z As Integer
Dim ut As Integer
Dim mo As Double
Dim es As Integer


Dim x1 As Double
Dim x2 As Double
Dim x3 As Double
Dim y1 As Integer
Dim y2 As Integer
Dim y3 As Integer

Dim chil(1000, 8) As Double
Dim achil(1, 9) As Double
Dim co(10, 8) As Double
Dim aco(1, 9) As Double


Sub master()
Erase chil()
Erase co()

chilcreate
cocreate

Erase aco()
i = 0
j = 0
Do While aco(1, 2) = 0 Or j > 100
i = 1 + 9 * Rnd
If co(i, 5) > 1 And co(i, 8) = 0 Then
aco(1, 1) = i
aco(1, 2) = co(i, 1)
aco(1, 3) = co(i, 2)
aco(1, 4) = co(i, 3)
aco(1, 5) = co(i, 4)
aco(1, 6) = co(i, 5)
aco(1, 7) = co(i, 6)
aco(1, 8) = co(i, 7)
aco(1, 9) = co(i, 8)

Else
i = 1 + 9 * Rnd
j = j + 1
End If

Loop
j = 0

achilreturn

For i = 1 To 9
Cells(5 + i, 5) = aco(1, i)
Cells(5 + i, 6) = achil(1, i)

Next


End Sub





Sub chilcreate()
j = 0
k = 0
m = 0
g = 0
a = 0
e = 0
p = 0
b = 0

Erase chil

For i = 1 To 1000

    Grundwerte
    
        chil(i, 1) = 1
        chil(i, 2) = g
        chil(i, 3) = a
        chil(i, 4) = e
        chil(i, 5) = 1.5 * b
        chil(i, 6) = p
        chil(i, 7) = b
        
         
    Next
For i = 1 To 1000
    
    For j = 1 To 7
    Cells(15 + i, 9 + j) = chil(i, j)
    Next



Next


End Sub

Sub cocreate()

L = 0
Z = 0
mo = 0
j = 0
k = 0
m = 0
g = 0
a = 0
e = 0
p = 0
b = 0
i = 0
ut = 0

For i = 1 To 10

    Grundwerte
    
    L = 2000 + 100000 * Rnd()
    Z = 1 + 11 * Rnd()
    mo = L
    es = 1 + 99 * Rnd()
    ut = 0
    
        co(i, 1) = g
        co(i, 2) = a
        co(i, 3) = e
        co(i, 4) = L
        co(i, 5) = Z
        co(i, 6) = mo
        co(i, 7) = es
        co(i, 8) = ut
          
    Next


End Sub


Sub achilreturn()

Erase achil


        j = 0
        i = 1 * 999 * Rnd()
    
        For j = 1 To 1000
        
            If chil(i, 1) = 1 And chil(i, 8) = 0 Then
            
            If aco(1, 2) = chil(i, 2) And aco(1, 3) = chil(i, 3) And aco(1, 4) = chil(i, 4) Then
                
                achil(1, 1) = i
                achil(1, 2) = chil(i, 1)
                achil(1, 3) = chil(i, 2)
                achil(1, 4) = chil(i, 3)
                achil(1, 5) = chil(i, 4)
                achil(1, 6) = chil(i, 5)
                achil(1, 7) = chil(i, 6)
                achil(1, 8) = chil(i, 7)
                achil(1, 9) = chil(i, 8)
                
    
                j = 1001
                End If
            
            End If
            i = i + 1
            
            If i = 1000 Then i = 1
            
        j = j + 1
Next
        
        
                If j = 1000 Then MsgBox "keine übereinstimmung"
    
    j = 0
    i = 0


End Sub





Sub Grundwerte()

x1 = 1 + 99 * Rnd()
x2 = 1 + 99 * Rnd()
x3 = 1 + 99 * Rnd()


If x1 < 52 Then g = 1 Else g = 2

Select Case x2
    Case 1 To 6
    a = 7
    Case 7 To 12
    a = 8
    Case 13 To 20
    a = 9
    Case 21 To 29
    a = 10
    Case 30 To 38
    a = 11
    Case 39 To 49
    a = 12
    Case 50 To 63
    a = 13
    Case 64 To 73
    a = 14
    Case 74 To 82
    a = 15
    Case 82 To 90
    a = 16
    Case 91 To 100
    a = 17
End Select

Select Case x3
    Case 1 To 13
    e = 1
    Case 14 To 42
    e = 2
    Case 43 To 57
    e = 3
    Case 58 To 83
    e = 4
    Case 84 To 100
    e = 5
End Select

p = 450 * a
b = 2

End Sub