' Generates Semi Magic Squares of Subtraction (11 x 11)
' Recalculate last four Columns
' Tested with Office 365 under Windows 10
Sub CnstrSqrs11a()
Dim a(121), a0(11, 11), a1(11), a2(11), s(24)
Dim n(11, 2)
Dim a3(11, 11), a4(11, 11), a5(20), d1(11), d2(11)
Dim b(121), Line11(11)
y = MsgBox("Blocked", vbExclamation, "CnstrSqrs11a")
End
Sheets("Klad1").Select
n1 = 0: n9 = 0: k1 = 1: k2 = 1
ShtNm1 = "GenLns11"
ShtNm2 = "ScrSht11"
t1 = Timer
For j100 = 97 To 114 '*** Recalculate Last 4 Columns ***
i2 = 1: i3 = 0
For i1 = 1 To 121:
i3 = i3 + 1: If i3 = 12 Then i3 = 1: i2 = i2 + 1
a0(i2, i3) = Sheets(ShtNm1).Cells(j100, i1)
Next i1
s1 = 671
Res11 = 61
Sheets(ShtNm2).Select
Cells.Select: Selection.ClearContents
Range("A1").Select
GoSub 500 ' Prepare Scratch Sheet
For i1 = 8 To 11
For i2 = 1 To 2
Cells(i1 - 7, i2 + 14).Value = n(i1, i2)
Next i2
Next i1
Sheets("Klad1").Select
For j1 = n(Ln11, 1) To n(Ln11, 2)
n10 = 11: Erase a
For i1 = 1 To 11
a1(i1) = Sheets(ShtNm2).Cells(j1, i1).Value
Next i1
For i1 = 1 To 11 ' First Line
a(i1) = a1(i1)
Next i1
For j2 = n(Ln11 + 1, 1) To n(Ln11 + 1, 2)
j300 = j2: GoSub 100: If fl1 = 0 Then GoTo 20
For j3 = n(Ln11 + 2, 1) To n(Ln11 + 2, 2)
j300 = j3: GoSub 100: If fl1 = 0 Then GoTo 30
For j4 = n(Ln11 + 3, 1) To n(Ln11 + 3, 2)
j300 = j4: GoSub 100: If fl1 = 0 Then GoTo 40
'' For j5 = n(5, 1) To n(5, 2)
'' j300 = j5: GoSub 100: If fl1 = 0 Then GoTo 50
'' For j6 = n(6, 1) To n(6, 2)
'' j300 = j6: GoSub 100: If fl1 = 0 Then GoTo 60
'' For j7 = n(7, 1) To n(7, 2)
'' j300 = j7: GoSub 100: If fl1 = 0 Then GoTo 70
'' For j8 = n(8, 1) To n(8, 2)
'' j300 = j8: GoSub 100: If fl1 = 0 Then GoTo 80
'' For j9 = n(9, 1) To n(9, 2)
'' j300 = j9: GoSub 100: If fl1 = 0 Then GoTo 90
'' For j10 = n(10, 1) To n(10, 2)
'' j300 = j10: GoSub 100: If fl1 = 0 Then GoTo 105
'' For j11 = n(11, 1) To n(11, 2)
'' j300 = j11: GoSub 100: If fl1 = 0 Then GoTo 110
Nc9 = Nc9 + 1 'Unchecked
n9 = n9 + 1: GoSub 750 'Print Semi Magic Squares
'Related number of Magic Squares Shown (n29)
End
5
'' n10 = n10 - 11
''110 Next j11
'' n10 = n10 - 11
''90 Next j9
'' n10 = n10 - 11
''80 Next j8
'' n10 = n10 - 11
''70 Next j7
'' n10 = n10 - 11
''60 Next j6
'' n10 = n10 - 11
''50 Next j5
n10 = n10 - 11
40 Next j4
n10 = n10 - 11
30 Next j3
n10 = n10 - 11
20 Next j2
n10 = n10 - 11
10 Next j1
1000 Next j100
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CnstrSqrs11a")
End
' Prepare Scratch Sheet
500 Ln11 = 8 '*** Start with Ln11 (Normal Ln11 = 1) ***
i90 = 0: n(Ln11, 1) = 1
For i1 = Ln11 To 11
For i2 = Ln11 To 11
For i3 = Ln11 To 11
For i4 = Ln11 To 11
For i5 = Ln11 To 11
For i6 = Ln11 To 11
For i7 = Ln11 To 11
For i8 = Ln11 To 11
For i9 = Ln11 To 11
For i10 = Ln11 To 11
For i11 = Ln11 To 11
s11 = a0(1, i1) + a0(2, i2) + a0(3, i3) + a0(4, i4) + a0(5, i5) + a0(6, i6) + a0(7, i7) + a0(8, i8) + a0(9, i9) + a0(10, i10) + a0(11, i11)
If s11 <> s1 Then GoTo 610
Erase b, Line11
b(a0(1, i1)) = a0(1, i1)
b(a0(2, i2)) = a0(2, i2)
b(a0(3, i3)) = a0(3, i3)
b(a0(4, i4)) = a0(4, i4)
b(a0(5, i5)) = a0(5, i5)
b(a0(6, i6)) = a0(6, i6)
b(a0(7, i7)) = a0(7, i7)
b(a0(8, i8)) = a0(8, i8)
b(a0(9, i9)) = a0(9, i9)
b(a0(10, i10)) = a0(10, i10)
b(a0(11, i11)) = a0(11, i11)
q2 = 0
For q1 = 1 To 121
If b(q1) = q1 Then
q2 = q2 + 1: Line11(q2) = q1
End If
Next q1
s12 = Line11(11) - Line11(10) + Line11(9) - Line11(8) + Line11(7) - Line11(6) + Line11(5) - Line11(4) + Line11(3) - Line11(2) + Line11(1)
If s12 <> Res11 Then GoTo 610
' Check Bimagic (Option)
''s12 = 0
''For q1 = 1 To 11
'' s12 = s12 + Line11(q1) ^ 2
''Next q1
''If s12 <> 54351 Then GoTo 610
i90 = i90 + 1
Cells(i90, 1).Value = a0(1, i1)
Cells(i90, 2).Value = a0(2, i2)
Cells(i90, 3).Value = a0(3, i3)
Cells(i90, 4).Value = a0(4, i4)
Cells(i90, 5).Value = a0(5, i5)
Cells(i90, 6).Value = a0(6, i6)
Cells(i90, 7).Value = a0(7, i7)
Cells(i90, 8).Value = a0(8, i8)
Cells(i90, 9).Value = a0(9, i9)
Cells(i90, 10).Value = a0(10, i10)
Cells(i90, 11).Value = a0(11, i11)
Cells(i90, 12).Value = s11 ''j100
Cells(1, 13).Value = i90
Cells(2, 13).Value = i1
610 Next i11
600 Next i10
590 Next i9
580 Next i8
570 Next i7
560 Next i6
550 Next i5
540 Next i4
530 Next i3
520 Next i2
n(i1, 2) = i90: If i1 <> 11 Then n(i1 + 1, 1) = i90 + 1
510 Next i1
n(11, 2) = i90
Return
' Construct Semi Magic Squares
100 fl1 = 1
For i1 = 1 To 11
a2(i1) = Sheets(ShtNm2).Cells(j300, i1).Value
Next i1
For i1 = 1 To 11
a20 = a2(i1)
For i2 = 1 To n10
If a20 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
n10 = n10 + 11
i2 = 0
For i1 = n10 - 11 + 1 To n10
i2 = i2 + 1
a(i1) = a2(i2)
Next i1
Return
' Print results (Semi Magic Squares)
' Related number of Magic Squares Shown (n29)
750 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 12: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 12
End If
'' Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
Cells(k1, k2 + 2).Value = n29
Cells(k1, k2 + 11).Value = j100 'Generator Magic Lines
i3 = 0
For i1 = 1 To 11
For i2 = 1 To 11
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
End Sub
