' Generates Semi Pan Magic Sudoku Comparable Cubes of order 5 for integers 0 thru 4
' Tested with Office 2007 under Windows 7
Sub SudCube5a()
Dim a(125), b(5)
y = MsgBox("Locked", vbCritical, "Routine SudCube5a")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 0: m2 = 4: s1 = 10
Sheets("Klad1").Select
t1 = Timer
' Generate Cubes
a(63) = 2
For j125 = m1 To m2
a(125) = j125
a(1) = 2 * s1 / 5 - a(125)
For j124 = m1 To m2
a(124) = j124
a(2) = 2 * s1 / 5 - a(124)
For j123 = m1 To m2
a(123) = j123
a(3) = 2 * s1 / 5 - a(123)
For j122 = m1 To m2
a(122) = j122
a(121) = s1 - a(122) - a(123) - a(124) - a(125)
If a(121) < 0 Or a(121) > 4 Then GoTo 1220
a(93) = -2 * s1 / 5 + a(122) + a(123) + a(124)
If a(93) < 0 Or a(93) > 4 Then GoTo 1220
a(33) = 2 * s1 / 5 - a(93): a(5) = 2 * s1 / 5 - a(121): a(4) = 2 * s1 / 5 - a(122):
For j120 = m1 To m2
a(120) = j120
a(105) = -a(120) + a(122) + a(123)
If a(105) < 0 Or a(105) > 4 Then GoTo 1200
a(96) = -2 * s1 / 5 - a(120) + a(122) + 2 * a(123) + a(124)
If a(96) < 0 Or a(96) > 4 Then GoTo 1200
a(30) = 2 * s1 / 5 - a(96): a(21) = 2 * s1 / 5 - a(105): a(6) = 2 * s1 / 5 - a(120):
For j119 = m1 To m2
a(119) = j119
a(112) = a(119) + a(120) - a(122)
If a(112) < 0 Or a(112) > 4 Then GoTo 1190
a(107) = s1 - a(119) - a(120) - a(124) - a(125)
If a(107) < 0 Or a(107) > 4 Then GoTo 1190
a(104) = s1 - a(119) - a(123) - a(124) - a(125)
If a(104) < 0 Or a(104) > 4 Then GoTo 1190
a(97) = 3 * s1 / 5 - a(119) - a(123)
If a(97) < 0 Or a(97) > 4 Then GoTo 1190
a(85) = 3 * s1 / 5 - a(119) - 2 * a(120) + a(122) + a(123) - a(125)
If a(85) < 0 Or a(85) > 4 Then GoTo 1190
a(77) = 3 * s1 / 5 - a(119) - a(120) + a(122) - a(125)
If a(77) < 0 Or a(77) > 4 Then GoTo 1190
a(74) = s1 / 5 - a(119) - a(120) + a(122) + a(123)
If a(74) < 0 Or a(74) > 4 Then GoTo 1190
a(52) = 2 * s1 / 5 - a(74): a(49) = 2 * s1 / 5 - a(77): a(41) = 2 * s1 / 5 - a(85): a(29) = 2 * s1 / 5 - a(97):
a(22) = 2 * s1 / 5 - a(104): a(19) = 2 * s1 / 5 - a(107): a(14) = 2 * s1 / 5 - a(112): a(7) = 2 * s1 / 5 - a(119):
For j118 = m1 To m2
a(118) = j118
a(114) = s1 - a(118) - a(119) - a(120) - a(124)
If a(114) < 0 Or a(114) > 4 Then GoTo 1180
a(111) = a(118) + a(119) - a(121)
If a(111) < 0 Or a(111) > 4 Then GoTo 1180
a(109) = -s1 + a(118) + a(119) + a(120) + a(123) + a(124) + a(125)
If a(109) < 0 Or a(109) > 4 Then GoTo 1180
a(106) = s1 - a(118) - a(119) - a(123) - a(124)
If a(106) < 0 Or a(106) > 4 Then GoTo 1180
a(103) = s1 - a(118) - a(122) - a(123) - a(124)
If a(103) < 0 Or a(103) > 4 Then GoTo 1180
a(98) = 8 * s1 / 5 - a(118) - 2 * a(122) - 2 * a(123) - 2 * a(124)
If a(98) < 0 Or a(98) > 4 Then GoTo 1180
a(94) = 8 * s1 / 5 - a(118) - 2 * a(119) - 2 * a(120) - a(124) - a(125)
If a(94) < 0 Or a(94) > 4 Then GoTo 1180
a(92) = -7 * s1 / 5 + a(118) + 2 * a(119) + 2 * a(120) + a(123) + a(124) + a(125)
If a(92) < 0 Or a(92) > 4 Then GoTo 1180
a(89) = -7 * s1 / 5 + a(118) + 3 * a(119) + 2 * a(120) - a(122) + a(123) + a(124) + a(125)
If a(89) < 0 Or a(89) > 4 Then GoTo 1180
a(88) = -2 * s1 / 5 + a(118) + a(122) + a(124)
If a(88) < 0 Or a(88) > 4 Then GoTo 1180
a(86) = 8 * s1 / 5 - a(118) - 2 * a(119) - a(120) - a(123) - a(124) - a(125)
If a(86) < 0 Or a(86) > 4 Then GoTo 1180
a(79) = -7 * s1 / 5 + a(118) + a(119) + a(120) + a(122) + a(123) + 2 * a(124) + a(125)
If a(79) < 0 Or a(79) > 4 Then GoTo 1180
a(76) = 8 * s1 / 5 - a(118) - a(119) - a(122) - 2 * a(123) - 2 * a(124)
If a(76) < 0 Or a(76) > 4 Then GoTo 1180
a(75) = 11 * s1 / 5 - a(118) - a(119) - 2 * a(122) - 3 * a(123) - 2 * a(124) - a(125)
If a(75) < 0 Or a(75) > 4 Then GoTo 1180
a(72) = -4 * s1 / 5 + a(118) + a(119) + a(120) + a(123) + a(124)
If a(72) < 0 Or a(72) > 4 Then GoTo 1180
a(70) = -9 * s1 / 5 + a(118) + 2 * a(119) + a(120) + a(122) + 2 * a(123) + 2 * a(124) + a(125)
If a(70) < 0 Or a(70) > 4 Then GoTo 1180
a(68) = 6 * s1 / 5 - a(118) - a(122) - 2 * a(123) - a(124)
If a(68) < 0 Or a(68) > 4 Then GoTo 1180
a(67) = 11 * s1 / 5 - a(118) - 3 * a(119) - 2 * a(120) - a(123) - 2 * a(124) - a(125)
If a(67) < 0 Or a(67) > 4 Then GoTo 1180
a(65) = 6 * s1 / 5 - a(118) - 2 * a(119) - 2 * a(120) + a(122) - a(124)
If a(65) < 0 Or a(65) > 4 Then GoTo 1180
a(61) = 2 * s1 / 5 - a(65): a(59) = 2 * s1 / 5 - a(67): a(58) = 2 * s1 / 5 - a(68): a(56) = 2 * s1 / 5 - a(70):
a(54) = 2 * s1 / 5 - a(72): a(51) = 2 * s1 / 5 - a(75): a(50) = 2 * s1 / 5 - a(76): a(47) = 2 * s1 / 5 - a(79):
a(40) = 2 * s1 / 5 - a(86): a(38) = 2 * s1 / 5 - a(88): a(37) = 2 * s1 / 5 - a(89): a(34) = 2 * s1 / 5 - a(92):
a(32) = 2 * s1 / 5 - a(94): a(28) = 2 * s1 / 5 - a(98): a(23) = 2 * s1 / 5 - a(103): a(20) = 2 * s1 / 5 - a(106):
a(17) = 2 * s1 / 5 - a(109): a(15) = 2 * s1 / 5 - a(111): a(12) = 2 * s1 / 5 - a(114): a(8) = 2 * s1 / 5 - a(118):
For j117 = m1 To m2
a(117) = j117
a(116) = s1 - a(117) - a(118) - a(119) - a(120)
If a(116) < 0 Or a(116) > 4 Then GoTo 1170
a(115) = a(117) + a(118) - a(125)
If a(115) < 0 Or a(115) > 4 Then GoTo 1170
a(113) = s1 - a(117) - a(118) - a(119) - a(123)
If a(113) < 0 Or a(113) > 4 Then GoTo 1170
a(110) = s1 - a(117) - a(118) - a(122) - a(123)
If a(110) < 0 Or a(110) > 4 Then GoTo 1170
a(108) = -s1 + a(117) + a(118) + a(119) + a(122) + a(123) + a(124)
If a(108) < 0 Or a(108) > 4 Then GoTo 1170
a(102) = -a(117) + a(124) + a(125)
If a(102) < 0 Or a(102) > 4 Then GoTo 1170
a(101) = -s1 + a(117) + a(118) + a(119) + a(120) + a(123) + a(124)
If a(101) < 0 Or a(101) > 4 Then GoTo 1170
a(100) = -7 * s1 / 5 + a(117) + a(118) + a(119) + a(120) + a(122) + 2 * a(123) + a(124)
If a(100) < 0 Or a(100) > 4 Then GoTo 1170
a(99) = 3 * s1 / 5 - a(117) - a(123)
If a(99) < 0 Or a(99) > 4 Then GoTo 1170
a(95) = 3 * s1 / 5 + a(117) - a(119) - a(123) - a(124)
If a(95) < 0 Or a(95) > 4 Then GoTo 1170
a(91) = 3 * s1 / 5 - a(117) + a(119) - a(122) - a(123)
If a(91) < 0 Or a(91) > 4 Then GoTo 1170
a(90) = -2 * s1 / 5 - a(117) + a(119) + a(120) + a(124) + a(125)
If a(90) < 0 Or a(90) > 4 Then GoTo 1170
a(87) = 8 * s1 / 5 + a(117) - a(118) - 2 * a(119) - 2 * a(120) - 2 * a(124) - a(125)
If a(87) < 0 Or a(87) > 4 Then GoTo 1170
a(84) = 8 * s1 / 5 + a(117) - a(118) - 2 * a(119) - a(120) - a(123) - 2 * a(124) - a(125)
If a(84) < 0 Or a(84) > 4 Then GoTo 1170
a(83) = 8 * s1 / 5 - a(117) - a(118) - a(119) - a(122) - 2 * a(123) - a(124)
If a(83) < 0 Or a(83) > 4 Then GoTo 1170
a(82) = -2 * s1 / 5 - a(117) + 2 * a(119) + a(120) - a(122) + a(124) + a(125)
If a(82) < 0 Or a(82) > 4 Then GoTo 1170
a(81) = -12 * s1 / 5 + a(117) + 2 * a(118) + 2 * a(119) + 2 * a(120) + a(122) + 2 * a(123) + 2 * a(124) + a(125)
If a(81) < 0 Or a(81) > 4 Then GoTo 1170
a(80) = 8 * s1 / 5 - a(117) - a(118) - 2 * a(122) - 2 * a(123) - a(124)
If a(80) < 0 Or a(80) > 4 Then GoTo 1170
a(78) = -7 * s1 / 5 + a(117) + a(118) + a(119) + a(122) + 3 * a(123) + a(124)
If a(78) < 0 Or a(78) > 4 Then GoTo 1170
a(73) = -9 * s1 / 5 + a(117) + a(118) + a(119) + 2 * a(122) + 3 * a(123) + 2 * a(124)
If a(73) < 0 Or a(73) > 4 Then GoTo 1170
a(71) = 6 * s1 / 5 - a(117) - a(118) - a(122) - 2 * a(123) - a(124) + a(125)
If a(71) < 0 Or a(71) > 4 Then GoTo 1170
a(69) = -4 * s1 / 5 - a(117) + a(118) + 2 * a(119) + 2 * a(120) - a(122) + a(124) + a(125)
If a(69) < 0 Or a(69) > 4 Then GoTo 1170
a(66) = s1 / 5 + a(117) - a(119) - a(120) + a(122) + a(123) - a(125)
If a(66) < 0 Or a(66) > 4 Then GoTo 1170
a(64) = 11 * s1 / 5 + a(117) - a(118) - 3 * a(119) - 2 * a(120) - a(123) - 2 * a(124) - 2 * a(125)
If a(64) < 0 Or a(64) > 4 Then GoTo 1170
a(62) = 2 * s1 / 5 - a(64): a(60) = 2 * s1 / 5 - a(66): a(57) = 2 * s1 / 5 - a(69): a(55) = 2 * s1 / 5 - a(71):
a(53) = 2 * s1 / 5 - a(73): a(48) = 2 * s1 / 5 - a(78): a(46) = 2 * s1 / 5 - a(80): a(45) = 2 * s1 / 5 - a(81):
a(44) = 2 * s1 / 5 - a(82): a(43) = 2 * s1 / 5 - a(83): a(42) = 2 * s1 / 5 - a(84): a(39) = 2 * s1 / 5 - a(87):
a(36) = 2 * s1 / 5 - a(90): a(35) = 2 * s1 / 5 - a(91): a(31) = 2 * s1 / 5 - a(95): a(27) = 2 * s1 / 5 - a(99):
a(26) = 2 * s1 / 5 - a(100): a(25) = 2 * s1 / 5 - a(101): a(24) = 2 * s1 / 5 - a(102): a(18) = 2 * s1 / 5 - a(108):
a(16) = 2 * s1 / 5 - a(110): a(13) = 2 * s1 / 5 - a(113): a(11) = 2 * s1 / 5 - a(115): a(10) = 2 * s1 / 5 - a(116):
a(9) = 2 * s1 / 5 - a(117):
' Exclude solutions with identical numbers in rows, colums, pillars
GoSub 800: If fl1 = 0 Then GoTo 1170
n9 = n9 + 1
' GoSub 1740 'Print results (selected numbers)
GoSub 1750 'Print results (planes 11, 12, 13, 14 and 15)
' GoSub 1760 'Print results (3d)
1170 Next j117
1180 Next j118
1190 Next j119
1200 Next j120
1220 Next j122
1230 Next j123
1240 Next j124
1250 Next j125
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions"
y = MsgBox(t10, 0, "Routine SudCube5a")
End
' Print results (selected numbers)
1740 For i1 = 1 To 125
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (planes 11, 12, 13, 14 and 15)
1750 n2 = n2 + 1
If n2 = 7 Then
n2 = 1: k1 = k1 + 30: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 6
End If
For i0 = 1 To 5
i3 = (5 - i0) * 25
For i1 = 1 To 5
For i2 = 1 To 5
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 6, k2 + i2).Value = a(i3)
Next i2
Next i1
If i0 = 1 Then
Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0) + ", C" + CStr(n9)
Else
Cells(k1 + (i0 - 1) * 6, k2 + 1).Value = "Plane 1" + CStr(i0)
End If
Next i0
Return
' Print results (3d)
1760 n2 = n2 + 1
If n2 = 4 Then
n2 = 1: k1 = k1 + 46: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 22
End If
For i0 = 1 To 5
i3 = (5 - i0) * 25
For i1 = 1 To 5
For i2 = 1 To 5
i3 = i3 + 1
Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 9, k2 + 9 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
Next i2
Next i1
Next i0
Return
' Exclude solutions with identical numbers in rows, colums and pillars
800 fl1 = 1
' Rows
i1 = -4
For i0 = 1 To 25
i1 = i1 + 5
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3): b(5) = a(i1 + 4)
GoSub 860
If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0: i2 = 0
For i0 = 1 To 25
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 5): b(3) = a(i1 + 10): b(4) = a(i1 + 15): b(5) = a(i1 + 20)
i2 = i2 + 1: If i2 = 5 Then i2 = 0: i1 = i1 + 20
GoSub 860
If fl1 = 0 Then Return
Next i0
' Pillars
i1 = 0: i2 = 0
For i0 = 1 To 25
i1 = i0
b(1) = a(i1): b(2) = a(i1 + 25): b(3) = a(i1 + 50): b(4) = a(i1 + 75): b(5) = a(i1 + 100)
GoSub 860
If fl1 = 0 Then Return
Next i0
Return
' Space Diagonals
850
b(1) = a(21): b(2) = a(42): b(3) = a(63): b(4) = a(84): b(5) = a(105): GoSub 860: If fl1 = 0 Then Return
b(1) = a(25): b(2) = a(44): b(3) = a(63): b(4) = a(82): b(5) = a(101): GoSub 860: If fl1 = 0 Then Return
b(1) = a(5): b(2) = a(34): b(3) = a(63): b(4) = a(92): b(5) = a(121): GoSub 860: If fl1 = 0 Then Return
b(1) = a(1): b(2) = a(32): b(3) = a(63): b(4) = a(94): b(5) = a(125): GoSub 860: If fl1 = 0 Then Return
Return
860 fl1 = 1
For j1 = 1 To 5
b2 = b(j1)
For j2 = (1 + j1) To 5
If b2 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
End Sub
