' Generates Semi Magic Squares of Subtraction (10 x 10)
' Recalculate last four Columns
' Tested with Office 365 under Windows 10
Sub CnstrSqrs10a()
Dim a(100), a0(10, 10), a1(10), a2(10), s(22)
Dim n(10, 2)
Dim a3(10, 10), a4(10, 10), a5(20), d1(10), d2(10)
Dim b(100), Line10(10)
y = MsgBox("Blocked", vbExclamation, "CnstrSqrs10a")
End
Sheets("Klad1").Select
n1 = 0: n9 = 0: k1 = 1: k2 = 1
ShtNm1 = "GenLns10"
ShtNm2 = "ScrSht10"
t1 = Timer
For j100 = 287 To 287 '*** Recalculate Last 4 Columns ***
i2 = 1: i3 = 0
For i1 = 1 To 100:
i3 = i3 + 1: If i3 = 11 Then i3 = 1: i2 = i2 + 1
a0(i2, i3) = Sheets(ShtNm1).Cells(j100, i1)
Next i1
s1 = 505
Res10 = 49
Sheets(ShtNm2).Select
Cells.Select: Selection.ClearContents
Range("A1").Select
GoSub 500 ' Prepare Scratch Sheet
Sheets("Klad1").Select
For j1 = n(Ln10, 1) To n(Ln10, 2)
n10 = 10: Erase a
For i1 = 1 To 10
a1(i1) = Sheets(ShtNm2).Cells(j1, i1).Value
Next i1
For i1 = 1 To 10 ' First Line
a(i1) = a1(i1)
Next i1
For j2 = n(Ln10 + 1, 1) To n(Ln10 + 1, 2)
j300 = j2: GoSub 100: If fl1 = 0 Then GoTo 20
For j3 = n(Ln10 + 2, 1) To n(Ln10 + 2, 2)
j300 = j3: GoSub 100: If fl1 = 0 Then GoTo 30
For j4 = n(Ln10 + 3, 1) To n(Ln10 + 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
Nc9 = Nc9 + 1 'Unchecked
n9 = n9 + 1: GoSub 750 'Print Semi Magic Squares
'Related number of Magic Squares Shown (n29)
End
5
'' n10 = n10 - 10
''105 Next j10
'' n10 = n10 - 10
''90 Next j9
'' n10 = n10 - 10
''80 Next j8
'' n10 = n10 - 10
''70 Next j7
'' n10 = n10 - 10
''60 Next j6
'' n10 = n10 - 10
''50 Next j5
n10 = n10 - 10
40 Next j4
n10 = n10 - 10
30 Next j3
n10 = n10 - 10
20 Next j2
n10 = n10 - 10
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 CnstrSqrs10a")
End
' Prepare Scratch Sheet
500 Ln10 = 7 '*** Start with Ln10 (Normal Ln10 = 1) ***
i90 = 0: n(Ln10, 1) = 1
For i1 = Ln10 To 10
For i2 = Ln10 To 10
For i3 = Ln10 To 10
For i4 = Ln10 To 10
For i5 = Ln10 To 10
For i6 = Ln10 To 10
For i7 = Ln10 To 10
For i8 = Ln10 To 10
For i9 = Ln10 To 10
For i10 = Ln10 To 10
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)
If s11 <> s1 Then GoTo 600
Erase b, Line10
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)
q2 = 0
For q1 = 1 To 100
If b(q1) = q1 Then
q2 = q2 + 1: Line10(q2) = q1
End If
Next q1
s12 = Line10(10) - Line10(9) + Line10(8) - Line10(7) + Line10(6) - Line10(5) + Line10(4) - Line10(3) + Line10(2) - Line10(1)
If s12 <> Res10 Then GoTo 600
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 = s11 ''j100
Cells(1, 12).Value = i90
Cells(2, 12).Value = i1
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 <> 10 Then n(i1 + 1, 1) = i90 + 1
510 Next i1
n(10, 2) = i90
Return
' Construct Semi Magic Squares
100 fl1 = 1
For i1 = 1 To 10
a2(i1) = Sheets(ShtNm2).Cells(j300, i1).Value
Next i1
For i1 = 1 To 10
a20 = a2(i1)
For i2 = 1 To n10
If a20 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
n10 = n10 + 10
i2 = 0
For i1 = n10 - 10 + 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 + 11: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 11
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 + 10).Value = j100 'Generator Magic Lines
i3 = 0
For i1 = 1 To 10
For i2 = 1 To 10
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a0(i1, i2) ''a(i3)
Next i2
Next i1
Return
End Sub
