Vorige Pagina About the Author

' Constructs Order 15 Generators, Consecutive Prime Numbers

' Tested with Office 365 under Windows 11

Sub MgcLns15()

Dim a1(225), a(15), b1(2500), b(2500)

y = MsgBox("Blocked", vbExclamation, "MgcLns15")
End

    Sheets("Klad1").Select

    Clmn15 = 2             'Column Number
    
    For i1 = 1 To 225
        a1(i1) = Sheets("Ranges15").Cells(i1 + 1, Clmn15).Value
    Next i1
    s15 = Sheets("Ranges15").Cells(1, Clmn15).Value

    For i1 = 1 To 225
        b1(a1(i1)) = a1(i1)
    Next i1

n15 = 225

Erase b

'   Block Corner Square (8 x 8), if applicable

    For i1 = 1 To 9
    For i2 = 1 To 9
        x = Cells(i1, i2).Value
        b(x) = x
    Next i2
    Next i1

For j1 = 1 To n15

x = Cells(n9 + 1, 1).Value
If n9 < 10 And x <> 0 Then
    a(1) = x: b(x) = x
Else
    If b(a1(j1)) = a1(j1) Then GoTo 10
    a(1) = a1(j1)
End If

For j2 = n15 To j1 + 1 Step -1

x = Cells(n9 + 1, 2).Value
If n9 < 10 And x <> 0 Then
    a(2) = x: b(x) = x
Else
    If b(a1(j2)) = a1(j2) Then GoTo 20
    a(2) = a1(j2)
End If

For j3 = j1 + 1 To n15

x = Cells(n9 + 1, 3).Value
If n9 < 10 And x <> 0 Then
    a(3) = x: b(x) = x
Else
    If b(a1(j3)) = a1(j3) Then GoTo 30
    a(3) = a1(j3)
End If

For j4 = n15 To j3 + 1 Step -1

x = Cells(n9 + 1, 4).Value
If n9 < 10 And x <> 0 Then
    a(4) = x: b(x) = x
Else
    If b(a1(j4)) = a1(j4) Then GoTo 40
    a(4) = a1(j4)

    If a(4) = a(2) Then GoTo 40
End If

For j5 = j3 + 1 To n15

x = Cells(n9 + 1, 5).Value
If n9 < 10 And x <> 0 Then
    a(5) = x: b(x) = x
Else
    If b(a1(j5)) = a1(j5) Then GoTo 50
    a(5) = a1(j5)
End If

For j6 = n15 To j5 + 1 Step -1

x = Cells(n9 + 1, 6).Value
If n9 < 10 And x <> 0 Then
    a(6) = x: b(x) = x
Else
    If b(a1(j6)) = a1(j6) Then GoTo 60
    a(6) = a1(j6)
    
    If a(6) = a(2) Or a(6) = a(4) Then GoTo 60
End If

For j7 = j5 + 1 To n15

x = Cells(n9 + 1, 7).Value
If n9 < 10 And x <> 0 Then
    a(7) = x: b(x) = x
Else
    If b(a1(j7)) = a1(j7) Then GoTo 70
    a(7) = a1(j7)
End If

For j8 = n15 To j7 + 1 Step -1

x = Cells(n9 + 1, 8).Value
If n9 < 10 And x <> 0 Then
    a(8) = x: b(x) = x
Else
    If b(a1(j8)) = a1(j8) Then GoTo 80
    a(8) = a1(j8)
End If

If a(8) = a(2) Or a(8) = a(4) Or a(8) = a(6) Then GoTo 80

For j9 = j7 + 1 To n15

x = Cells(n9 + 1, 9).Value
If n9 < 10 And x <> 0 Then
    a(9) = x: b(x) = x
Else
    If b(a1(j9)) = a1(j9) Then GoTo 90
    a(9) = a1(j9)
End If

For j10 = n15 To j9 + 1 Step -1
If b(a1(j10)) = a1(j10) Then GoTo 100
a(10) = a1(j10)

If a(10) = a(2) Or a(10) = a(4) Or a(10) = a(6) Or a(10) = a(8) Then GoTo 100

For j11 = j9 + 1 To n15
If b(a1(j11)) = a1(j11) Then GoTo 110
a(11) = a1(j11)

For j12 = n15 To j11 + 1 Step -1
If b(a1(j12)) = a1(j12) Then GoTo 120
a(12) = a1(j12)

For j13 = j10 + 1 To n15
If b(a1(j13)) = a1(j13) Then GoTo 130
a(13) = a1(j13)

For j14 = n15 To j13 + 1 Step -1
If b(a1(j14)) = a1(j14) Then GoTo 140
a(14) = a1(j14)

a(15) = s15 - a(1) - a(2) - a(3) - a(4) - a(5) - a(6) - a(7) - a(8) - a(9) - a(10) - a(11) - a(12) - a(13) - a(14)
If a(15) < a1(1) Or a(15) > a1(225) Then GoTo 140
If b(a(15)) = a(15) Then GoTo 140
If b1(a(15)) <> a(15) Then GoTo 140

    GoSub 500: If fl1 = 0 Then GoTo 140     'Check Identical Numbers
    
    n9 = n9 + 1:
    For i1 = 1 To 15
        Cells(n9, i1).Value = a(i1)
    Next i1
''  Cells(n9, 16).Value = n9
''  Cells(n9, 17).Value = n15
    
    For i1 = 1 To 15
        b(a(i1)) = a(i1)
    Next i1
   
    GoTo 10

End

140 Next j14
130 Next j13
120 Next j12
110 Next j11
100 Next j10
90 Next j9
80 Next j8
70 Next j7
60 Next j6
50 Next j5
40 Next j4
30 Next j3
20 Next j2
10 Next j1

'  Print Remainder (If applicable)

If n9 < 14 Then

''y = MsgBox(CStr(n9), 0, "Test")

i2 = 0
For i1 = 1 To 225
    i3 = a1(i1)

    If b(i3) = 0 Then
        i2 = i2 + 1
        Cells(n9 + 1, i2).Value = i3
    End If
Next i1

End If

End

'  Check Line

500 fl1 = 1

    For i1 = 1 To 15
        a2 = a(i1)
        For i2 = i1 + 1 To 15
            If a(i2) = a2 Then fl1 = 0: Return
        Next i2
    Next i1

    Return

End Sub

Vorige Pagina About the Author