Vorige Pagina About the Author

' Generates Composed Magic Squares of order 13 based on Sub Square Collections

' Tested with Office 2007 under Windows 7

Sub CmbSqr13()

Dim a(169), SqrNr1(8)
Dim a1(16), b1(16), c1(25), d1(16), e1(16), g1(25), i10(49), h1(81)

y = MsgBox("Locked", vbCritical, "Routine CmbSqr13")
End

n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 169: s1 = 1105

    Sheets("Solutions1267").Select

    t1 = Timer

    For j1 = 2 To 61
        
        n9 = n9 + 1
        For j2 = 1 To 8
            SqrNr1(j2) = Sheets("Index1").Cells(j1, j2 + 1).Value
        Next j2

        j10 = SqrNr1(3)
        If n9 <= 36 Then
            Sht1 = "Solutions1261"
        Else
            Sht1 = "Solutions1262"
        End If
        GoSub 100                               'Read Center Square C
        
        j10 = SqrNr1(6): Sht1 = "Solutions1263"
        GoSub 200                               'Read Center Square G
       
        j10 = SqrNr1(1): Sht1 = "Solutions1264"
        GoSub 310                               'Read Center Square A
       
        j10 = SqrNr1(2) + 16: Sht1 = "Solutions1264"
        GoSub 320                               'Read Center Square B
       
        j10 = SqrNr1(4) + 32: Sht1 = "Solutions1264"
        GoSub 330                               'Read Center Square D
      
        j10 = SqrNr1(5) + 48: Sht1 = "Solutions1264"
        GoSub 340                               'Read Center Square E
                
        j10 = SqrNr1(7): Sht1 = "Solutions1265"
        GoSub 400                               'Read Center Square I
               
        j10 = SqrNr1(8): Sht1 = "Solutions1266"
        GoSub 500                               'Read Center Square H
               
        GoSub 2650 'Print Square J (13 x 13)
        
    Next j1

    t2 = Timer
    
    t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
    y = MsgBox(t10, 0, "Routine CmbSqr13")

End

'   Read Center Square C (5 x 5)

100 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 6
    k22 = 1 + (k12 - 1) * 6

    i3 = 0
    For i1 = 1 To 5
       For i2 = 1 To 5
           i3 = i3 + 1
           c1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1
    
    a(57) = c1(1):   a(58) = c1(2):   a(59) = c1(3):   a(60) = c1(4):   a(61) = c1(5):
    a(70) = c1(6):   a(71) = c1(7):   a(72) = c1(8):   a(73) = c1(9):   a(74) = c1(10):
    a(83) = c1(11):  a(84) = c1(12):  a(85) = c1(13):  a(86) = c1(14):  a(87) = c1(15):
    a(96) = c1(16):  a(97) = c1(17):  a(98) = c1(18):  a(99) = c1(19):  a(100) = c1(20):
    a(109) = c1(21): a(110) = c1(22): a(111) = c1(23): a(112) = c1(24): a(113) = c1(25):
    
    Return
    
'   Read Coner Square G (5 x 5)

200 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 6
    k22 = 1 + (k12 - 1) * 6

    i3 = 0
    For i1 = 1 To 5
       For i2 = 1 To 5
           i3 = i3 + 1
           g1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(105) = g1(1):  a(106) = g1(2):  a(107) = g1(3):  a(108) = g1(4):  a(109) = g1(5):
    a(118) = g1(6):  a(119) = g1(7):  a(120) = g1(8):  a(121) = g1(9):  a(122) = g1(10):
    a(131) = g1(11): a(132) = g1(12): a(133) = g1(13): a(134) = g1(14): a(135) = g1(15):
    a(144) = g1(16): a(145) = g1(17): a(146) = g1(18): a(147) = g1(19): a(148) = g1(20):
    a(157) = g1(21): a(158) = g1(22): a(159) = g1(23): a(160) = g1(24): a(161) = g1(25):

    Return
    
'   Read Border Square A (4 x 4)

310 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 5
    k22 = 1 + (k12 - 1) * 5

    i3 = 0
    For i1 = 1 To 4
       For i2 = 1 To 4
           i3 = i3 + 1
           a1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(1) = a1(1):   a(2) = a1(2):   a(3) = a1(3):   a(4) = a1(4):
    a(14) = a1(5):  a(15) = a1(6):  a(16) = a1(7):  a(17) = a1(8):
    a(27) = a1(9):  a(28) = a1(10): a(29) = a1(11): a(30) = a1(12):
    a(40) = a1(13): a(41) = a1(14): a(42) = a1(15): a(43) = a1(16):
    
    Return

'   Read Border Square B (4 x 4)

320 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 5
    k22 = 1 + (k12 - 1) * 5

    i3 = 0
    For i1 = 1 To 4
       For i2 = 1 To 4
           i3 = i3 + 1
           b1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(53) = b1(1):  a(54) = b1(2):  a(55) = b1(3):  a(56) = b1(4):
    a(66) = b1(5):  a(67) = b1(6):  a(68) = b1(7):  a(69) = b1(8):
    a(79) = b1(9):  a(80) = b1(10): a(81) = b1(11): a(82) = b1(12):
    a(92) = b1(13): a(93) = b1(14): a(94) = b1(15): a(95) = b1(16):

    Return

'   Read Border Square D (4 x 4)

330 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 5
    k22 = 1 + (k12 - 1) * 5

    i3 = 0
    For i1 = 1 To 4
       For i2 = 1 To 4
           i3 = i3 + 1
           d1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(123) = d1(1):  a(124) = d1(2):  a(125) = d1(3):  a(126) = d1(4):
    a(136) = d1(5):  a(137) = d1(6):  a(138) = d1(7):  a(139) = d1(8):
    a(149) = d1(9):  a(150) = d1(10): a(151) = d1(11): a(152) = d1(12):
    a(162) = d1(13): a(163) = d1(14): a(164) = d1(15): a(165) = d1(16):

    Return

'   Read Border Square E (4 x 4)

340 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 5
    k22 = 1 + (k12 - 1) * 5

    i3 = 0
    For i1 = 1 To 4
       For i2 = 1 To 4
           i3 = i3 + 1
           e1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(127) = e1(1):  a(128) = e1(2):  a(129) = e1(3):  a(130) = e1(4):
    a(140) = e1(5):  a(141) = e1(6):  a(142) = e1(7):  a(143) = e1(8):
    a(153) = e1(9):  a(154) = e1(10): a(155) = e1(11): a(156) = e1(12):
    a(166) = e1(13): a(167) = e1(14): a(168) = e1(15): a(169) = e1(16):

    Return

'   Read Border I (7 x 7)

400 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 8
    k22 = 1 + (k12 - 1) * 8

    i3 = 0
    For i1 = 1 To 7
       For i2 = 1 To 7
           i3 = i3 + 1
           i10(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(31) = i10(1):   a(32) = i10(2): a(33) = i10(3):  a(34) = i10(4):  a(35) = i10(5):  a(36) = i10(6):  a(37) = i10(7):
    a(44) = i10(8):   a(45) = i10(9): a(46) = i10(10): a(47) = i10(11): a(48) = i10(12): a(49) = i10(13): a(50) = i10(14):
    a(62) = i10(20):  a(63) = i10(21):
    a(75) = i10(27):  a(76) = i10(28):
    a(88) = i10(34):  a(89) = i10(35):
    a(101) = i10(41): a(102) = i10(42):
    a(114) = i10(48): a(115) = i10(49):

    Return

'   Read border H (9 x 9)

500 k11 = Int((j10 - 1) / 4)
    k12 = j10 - k11 * 4

    k21 = 1 + k11 * 10
    k22 = 1 + (k12 - 1) * 10

    i3 = 0
    For i1 = 1 To 9
       For i2 = 1 To 9
           i3 = i3 + 1
           h1(i3) = Sheets(Sht1).Cells(k21 + i1, k22 + i2).Value
       Next i2
    Next i1

    a(5) = h1(1):    a(6) = h1(2):   a(7) = h1(3):   a(8) = h1(4):   a(9) = h1(5):   a(10) = h1(6):  a(11) = h1(7):  a(12) = h1(8):  a(13) = h1(9):
    a(18) = h1(10):  a(19) = h1(11): a(20) = h1(12): a(21) = h1(13): a(22) = h1(14): a(23) = h1(15): a(24) = h1(16): a(25) = h1(17): a(26) = h1(18):
    a(38) = h1(26):  a(39) = h1(27):
    a(51) = h1(35):  a(52) = h1(36):
    a(64) = h1(44):  a(65) = h1(45):
    a(77) = h1(53):  a(78) = h1(54):
    a(90) = h1(62):  a(91) = h1(63):
    a(103) = h1(71): a(104) = h1(72):
    a(116) = h1(80): a(117) = h1(81):

    Return

'    Print results (squares)

2650 n2 = n2 + 1
     If n2 = 3 Then
         n2 = 1: k1 = k1 + 14: k2 = 1
     Else
         If n9 > 1 Then k2 = k2 + 14
     End If
       
     Cells(k1, k2 + 1).Select
     Cells(k1, k2 + 1).Font.Color = -4165632
     Cells(k1, k2 + 1).Value = n9
    
     i3 = 0
     For i1 = 1 To 13
         For i2 = 1 To 13
             i3 = i3 + 1
             Cells(k1 + i1, k2 + i2).Value = a(i3)
         Next i2
     Next i1
    
     Return

End Sub

Vorige Pagina About the Author