' Constructs Symmetric Centre Rows s5 = 35, s15 = 105
' Tested with Office 365 under Windows 11
Sub CntrRws15()
Dim a(15), a1(15)
y = MsgBox("Locked", vbCritical, "Routine CntrRws15")
End
Sheets("Klad1").Select
For i1 = 1 To 15
a1(i1) = i1 - 1
Next i1
m1 = 1: m2 = 15: s1 = 105
t1 = Timer
a(8) = 7
For j15 = m1 To m2
a(15) = a1(j15)
If a(15) = a(8) Then GoTo 140
For j14 = m1 To m2
a(14) = a1(j14)
If a(14) = a(15) Or a(14) = a(8) Then GoTo 140
For j13 = m1 To m2
a(13) = a1(j13)
If a(13) = a(14) Or a(13) = a(15) Or a(13) = a(8) Then GoTo 130
For j12 = m1 To m2
a(12) = a1(j12)
If a(12) = a(13) Or a(12) = a(14) Or a(12) = a(15) Or a(12) = a(8) Then GoTo 120
For j11 = m1 To m2
a(11) = a1(j11)
If a(11) = a(12) Or a(11) = a(13) Or a(11) = a(14) Or a(11) = a(15) Or a(11) = a(8) Then GoTo 110
For j10 = m1 To m2
a(10) = a1(j10)
If a(10) = a(12) Or a(10) = a(13) Or a(10) = a(14) Or a(10) = a(15) Or a(10) = a(8) Then GoTo 100
If a(10) = a(11) Then GoTo 100
a(9) = 7 + a(10) - a(12) + a(13) - a(15)
If a(9) = a(12) Or a(9) = a(13) Or a(9) = a(14) Or a(9) = a(15) Or a(9) = a(8) Then GoTo 90
If a(9) = a(10) Or a(9) = a(11) Then GoTo 90
If a(9) < 0 Or a(9) > 14 Then GoTo 90
a(1) = 14 - a(15): a(2) = 14 - a(14): a(3) = 14 - a(13): a(4) = 14 - a(12)
a(5) = 14 - a(11): a(6) = 14 - a(10): a(7) = 14 - a(9)
GoSub 800: If fl1 = 0 Then GoTo 90 'Check Identical Numbers
n9 = n9 + 1: GoSub 640 'Print TopRows
''n9 = n9 + 1: Cells(1, 17).Value = n9 'Counting
90
100 Next j10
110 Next j11
120 Next j12
130 Next j13
140 Next j14
150 Next j15
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CntrRws15")
End
' Print results (selected numbers)
640 For i1 = 1 To 15
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 16).Value = n9
Cells(1, 17).Value = n9
Return
' Exclude solutions with identical numbers
800 fl1 = 1
For j1 = 1 To 15
a2 = a(j1)
For j2 = (1 + j1) To 15
If a2 = a(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
End Sub
