Vorige Pagina Volgende Pagina About the Author

' Generates Semi Magic Squares of Subtraction (9 x 9)
' Part I, Magic Rows and Columns

' Tested with Office 365 under Windows 10

Sub CnstrSqrs9a()

Dim a(81), a0(9, 9), a1(9), a2(9), s(20)
Dim n(9, 2)
Dim a3(9, 9), a4(9, 9), a5(20), d1(9), d2(9)
Dim b(81), Line9(9)

Dim b1(9), b2(9)

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

Sheets("Klad1").Select

n1 = 0: n9 = 0: k1 = 1: k2 = 1

ShtNm1 = "GenLns9"
ShtNm2 = "ScrSht9"

t1 = Timer

For j100 = 252 To 295 ''197 To 250 ''1 To 196

i2 = 1: i3 = 0
For i1 = 1 To 81:
    i3 = i3 + 1: If i3 = 10 Then i3 = 1: i2 = i2 + 1
    a0(i2, i3) = Sheets(ShtNm1).Cells(j100, i1)
Next i1
s1 = 369                     'Magic Sum
s2 = 20049                   'Sum of Squares
Res9 = 41                    'Residuum

    Sheets(ShtNm2).Select
    Cells.Select: Selection.ClearContents
    Range("A1").Select
    
    GoSub 500               ' Prepare Scratch Sheet
    
    Sheets("Klad1").Select
       
    For j1 = n(1, 1) To n(1, 2)
    
    n10 = 9: Erase a
    For i1 = 1 To 9
        a1(i1) = Sheets(ShtNm2).Cells(j1, i1).Value
    Next i1
    For i1 = 1 To 9         ' First Line
        a(i1) = a1(i1)
    Next i1
    
    For j2 = n(2, 1) To n(2, 2)
    j300 = j2: GoSub 100: If fl1 = 0 Then GoTo 20
    
    For j3 = n(3, 1) To n(3, 2)
    j300 = j3: GoSub 100: If fl1 = 0 Then GoTo 30
    
    For j4 = n(4, 1) To n(4, 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
   
       Nc9 = Nc9 + 1                        'Unchecked (Diagonals)
      
       n9 = n9 + 1: GoSub 750               'Print Semi Magic Squares
                                            'Related number of Magic Squares Shown (n29)
5
       n10 = n10 - 9
90     Next j9
       n10 = n10 - 9
80     Next j8
       n10 = n10 - 9
70     Next j7
       n10 = n10 - 9
60     Next j6
       n10 = n10 - 9
50     Next j5
       n10 = n10 - 9
40     Next j4
       n10 = n10 - 9
30     Next j3
       n10 = n10 - 9
20     Next j2
       n10 = n10 - 9
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 CnstrSqrs9a")
End

'   Prepare Scratch Sheet

500

i90 = 0: n(1, 1) = 1

For i1 = 1 To 9
For i2 = 1 To 9
For i3 = 1 To 9
For i4 = 1 To 9
For i5 = 1 To 9
For i6 = 1 To 9
For i7 = 1 To 9
For i8 = 1 To 9
For i9 = 1 To 9

    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)
    If s11 <> s1 Then GoTo 590
 
''  s21 = a0(1,i1)^2 + a0(2,i2)^2 + a0(3,i3)^2 + a0(4,i4)^2 + a0(5,i5)^2 + a0(6,i6)^2 + a0(7,i7)^2 + a0(8,i8)^2 + a0(9,i9)^2
''  If s21 <> s2 Then GoTo 590  (Option, No Results) 
 
Erase b, Line9
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)
    
q2 = 0
For q1 = 1 To 81
    If b(q1) = q1 Then
        q2 = q2 + 1: Line9(q2) = q1
    End If
Next q1
    
s12 = Line9(9) - Line9(8) + Line9(7) - Line9(6) + Line9(5) - Line9(4) + Line9(3) - Line9(2) + Line9(1)
If s12 <> Res9 Then GoTo 590
   
    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 = s11 ''j100

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 <> 9 Then n(i1 + 1, 1) = i90 + 1

510 Next i1

    n(9, 2) = i90
   
    Return

'   Construct Semi Magic Squares

100 fl1 = 1

    For i1 = 1 To 9
        a2(i1) = Sheets(ShtNm2).Cells(j300, i1).Value
    Next i1

    For i1 = 1 To 9
    a20 = a2(i1)
    For i2 = 1 To n10
        If a20 = a(i2) Then fl1 = 0: Return
    Next i2
    Next i1
    
    n10 = n10 + 9
    i2 = 0
    For i1 = n10 - 9 + 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 + 10: k2 = 1
    Else
        If n9 > 1 Then k2 = k2 + 10
    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 + 9).Value = j100  'Generator  Magic Lines
    
    i3 = 0
    For i1 = 1 To 9
        For i2 = 1 To 9
            i3 = i3 + 1
            Cells(k1 + i1, k2 + i2).Value = a(i3) ''
        Next i2
    Next i1
   
    Return

End Sub

Vorige Pagina Volgende Pagina About the Author