' Combines Sudoku Comparable Cubes into Almost Perfect Magic Cubes
' Tested with Office 2007 under Windows 7
Sub CnstrCbs4()
Dim b(3, 64), a(64), c(4), s2(4), s(12, 10)
Sheets("Klad1").Select
y = MsgBox("Locked", vbCritical, "Routine CnstrCbs4")
End
n4 = 56 'Sudoku41: 4
'Sudoku42: 56
n2 = 0: n9 = 0: k1 = 1: k2 = 1
s1 = 130
For j1 = 1 To n4
For j2 = 1 To n4
If j2 = j1 Then GoTo 20
For j3 = 1 To n4
If j3 = j1 Or j3 = j2 Then GoTo 30
j10 = j1: j20 = 1: GoSub 100 'Read Sudoku Comparable Cube 1
j10 = j2: j20 = 2: GoSub 100 'Read Sudoku Comparable Cube 2
j10 = j3: j20 = 3: GoSub 100 'Read Sudoku Comparable Cube 3
For j4 = 1 To 64
a(j4) = b(1, j4) + 4 * b(2, j4) + 16 * b(3, j4) + 1
Next j4
GoSub 200: If fl1 = 0 Then GoTo 30 'Check Magic Sum
GoSub 300: If fl1 = 0 Then GoTo 30 'Ckeck identical numbers
n9 = n9 + 1: GoSub 740 'Print results (selected numbers)
' n9 = n9 + 1: GoSub 750 'Print results (planes 1, 2, 3, 4)
' n9 = n9 + 1: GoSub 760 'Print results (3d)
30 Next j3
20 Next j2
Next j1
End
' Read Sudoku Comparable Cubes
100 i3 = 0
k11 = Int((j10 - 1) / 8)
k12 = j10 - k11 * 8
k21 = 2 + k11 * 20
k22 = 2 + (k12 - 1) * 5
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
b(j20, i3) = Sheets("Sudoku42").Cells(k21 - 1 + i1 + (i0 - 1) * 5, k22 - 1 + i2).Value 'load cube
Next i2
Next i1
Next i0
Return
' Check Magic Sum
200 fl1 = 1
' Plane 11 (Top) Plane 21 (Left) Plane 31 (Back)
s(1, 1) = a(49) + a(50) + a(51) + a(52): s(5, 1) = a(61) + a(57) + a(53) + a(49): s(9, 1) = a(49) + a(50) + a(51) + a(52)
s(1, 2) = a(53) + a(54) + a(55) + a(56): s(5, 2) = a(45) + a(41) + a(37) + a(33): s(9, 2) = a(33) + a(34) + a(35) + a(36)
s(1, 3) = a(57) + a(58) + a(59) + a(60): s(5, 3) = a(29) + a(25) + a(21) + a(17): s(9, 3) = a(17) + a(18) + a(19) + a(20)
s(1, 4) = a(61) + a(62) + a(63) + a(64): s(5, 4) = a(13) + a(9) + a(5) + a(1): s(9, 4) = a(1) + a(2) + a(3) + a(4)
s(1, 5) = a(49) + a(53) + a(57) + a(61): s(5, 5) = a(61) + a(45) + a(29) + a(13): s(9, 5) = a(49) + a(33) + a(17) + a(1)
s(1, 6) = a(50) + a(54) + a(58) + a(62): s(5, 6) = a(57) + a(41) + a(25) + a(9): s(9, 6) = a(50) + a(34) + a(18) + a(2)
s(1, 7) = a(51) + a(55) + a(59) + a(63): s(5, 7) = a(53) + a(37) + a(21) + a(5): s(9, 7) = a(51) + a(35) + a(19) + a(3)
s(1, 8) = a(52) + a(56) + a(60) + a(64): s(5, 8) = a(49) + a(33) + a(17) + a(1): s(9, 8) = a(52) + a(36) + a(20) + a(4)
s(1, 9) = a(49) + a(54) + a(59) + a(64): s(5, 9) = a(61) + a(41) + a(21) + a(1): s(9, 9) = a(49) + a(34) + a(19) + a(4)
s(1, 10) = a(52) + a(55) + a(58) + a(61): s(5, 10) = a(49) + a(37) + a(25) + a(13): s(9, 10) = a(52) + a(35) + a(18) + a(1)
' Plane 12 Plane 22 Plane 32
s(2, 1) = a(33) + a(34) + a(35) + a(36): s(6, 1) = a(62) + a(58) + a(54) + a(50): s(10, 1) = a(53) + a(54) + a(55) + a(56)
s(2, 2) = a(37) + a(38) + a(39) + a(40): s(6, 2) = a(46) + a(42) + a(38) + a(34): s(10, 2) = a(37) + a(38) + a(39) + a(40)
s(2, 3) = a(41) + a(42) + a(43) + a(44): s(6, 3) = a(30) + a(26) + a(22) + a(18): s(10, 3) = a(21) + a(22) + a(23) + a(24)
s(2, 4) = a(45) + a(46) + a(47) + a(48): s(6, 4) = a(14) + a(10) + a(6) + a(2): s(10, 4) = a(5) + a(6) + a(7) + a(8)
s(2, 5) = a(33) + a(37) + a(41) + a(45): s(6, 5) = a(62) + a(46) + a(30) + a(14): s(10, 5) = a(53) + a(37) + a(21) + a(5)
s(2, 6) = a(34) + a(38) + a(42) + a(46): s(6, 6) = a(58) + a(42) + a(26) + a(10): s(10, 6) = a(54) + a(38) + a(22) + a(6)
s(2, 7) = a(35) + a(39) + a(43) + a(47): s(6, 7) = a(54) + a(38) + a(22) + a(6): s(10, 7) = a(55) + a(39) + a(23) + a(7)
s(2, 8) = a(36) + a(40) + a(44) + a(48): s(6, 8) = a(50) + a(34) + a(18) + a(2): s(10, 8) = a(56) + a(40) + a(24) + a(8)
s(2, 9) = a(33) + a(38) + a(43) + a(48): s(6, 9) = a(62) + a(42) + a(22) + a(2): s(10, 9) = a(53) + a(38) + a(23) + a(8)
s(2, 10) = a(36) + a(39) + a(42) + a(45): s(6, 10) = a(50) + a(38) + a(26) + a(14): s(10, 10) = a(56) + a(39) + a(22) + a(5)
' Plane 13 Plane 23 Plane 33
s(3, 1) = a(17) + a(18) + a(19) + a(20): s(7, 1) = a(63) + a(59) + a(55) + a(51): s(11, 1) = a(57) + a(58) + a(59) + a(60)
s(3, 2) = a(21) + a(22) + a(23) + a(24): s(7, 2) = a(47) + a(43) + a(39) + a(35): s(11, 2) = a(41) + a(42) + a(43) + a(44)
s(3, 3) = a(25) + a(26) + a(27) + a(28): s(7, 3) = a(31) + a(27) + a(23) + a(19): s(11, 3) = a(25) + a(26) + a(27) + a(28)
s(3, 4) = a(29) + a(30) + a(31) + a(32): s(7, 4) = a(15) + a(11) + a(7) + a(3): s(11, 4) = a(9) + a(10) + a(11) + a(12)
s(3, 5) = a(17) + a(21) + a(25) + a(29): s(7, 5) = a(63) + a(47) + a(31) + a(15): s(11, 5) = a(57) + a(41) + a(25) + a(9)
s(3, 6) = a(18) + a(22) + a(26) + a(30): s(7, 6) = a(59) + a(43) + a(27) + a(11): s(11, 6) = a(58) + a(42) + a(26) + a(10)
s(3, 7) = a(19) + a(23) + a(27) + a(31): s(7, 7) = a(55) + a(39) + a(23) + a(7): s(11, 7) = a(59) + a(43) + a(27) + a(11)
s(3, 8) = a(20) + a(24) + a(28) + a(32): s(7, 8) = a(51) + a(35) + a(19) + a(3): s(11, 8) = a(60) + a(44) + a(28) + a(12)
s(3, 9) = a(17) + a(22) + a(27) + a(32): s(7, 9) = a(63) + a(43) + a(23) + a(3): s(11, 9) = a(57) + a(42) + a(27) + a(12)
s(3, 10) = a(20) + a(23) + a(26) + a(29): s(7, 10) = a(51) + a(39) + a(27) + a(15): s(11, 10) = a(60) + a(43) + a(26) + a(9)
' Plane 14 Plane 24 Plane 34
s(4, 1) = a(1) + a(2) + a(3) + a(4): s(8, 1) = a(64) + a(60) + a(56) + a(52): s(12, 1) = a(61) + a(62) + a(63) + a(64)
s(4, 2) = a(5) + a(6) + a(7) + a(8): s(8, 2) = a(48) + a(44) + a(40) + a(36): s(12, 2) = a(45) + a(46) + a(47) + a(48)
s(4, 3) = a(9) + a(10) + a(11) + a(12): s(8, 3) = a(32) + a(28) + a(24) + a(20): s(12, 3) = a(29) + a(30) + a(31) + a(32)
s(4, 4) = a(13) + a(14) + a(15) + a(16): s(8, 4) = a(16) + a(12) + a(8) + a(4): s(12, 4) = a(13) + a(14) + a(15) + a(16)
s(4, 5) = a(1) + a(5) + a(9) + a(13): s(8, 5) = a(64) + a(48) + a(32) + a(16): s(12, 5) = a(61) + a(45) + a(29) + a(13)
s(4, 6) = a(2) + a(6) + a(10) + a(14): s(8, 6) = a(60) + a(44) + a(28) + a(12): s(12, 6) = a(62) + a(46) + a(30) + a(14)
s(4, 7) = a(3) + a(7) + a(11) + a(15): s(8, 7) = a(56) + a(40) + a(24) + a(8): s(12, 7) = a(63) + a(47) + a(31) + a(15)
s(4, 8) = a(4) + a(8) + a(12) + a(16): s(8, 8) = a(52) + a(36) + a(20) + a(4): s(12, 8) = a(64) + a(48) + a(32) + a(16)
s(4, 9) = a(1) + a(6) + a(11) + a(16): s(8, 9) = a(64) + a(44) + a(24) + a(4): s(12, 9) = a(61) + a(46) + a(31) + a(16)
s(4, 10) = a(4) + a(7) + a(10) + a(13): s(8, 10) = a(52) + a(40) + a(28) + a(16): s(12, 10) = a(64) + a(47) + a(30) + a(13)
' Space Diagonals
s2(1) = a(13) + a(26) + a(39) + a(52)
s2(2) = a(16) + a(27) + a(38) + a(49)
s2(3) = a(1) + a(22) + a(43) + a(64)
s2(4) = a(4) + a(23) + a(42) + a(61)
For i1 = 1 To 12
For i2 = 1 To 10
If s(i1, i2) <> s1 Then fl1 = 0: Return
Next i2
Next i1
For i1 = 1 To 4
''If s2(i1) <> s1 Then fl1 = 0: Return
Next i1
Return
' Check identical numbers
300 fl1 = 1
For i1 = 1 To 64
a2 = a(i1)
For i2 = (1 + i1) To 64
If a2 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
' Print results (selected numbers)
740 Cells(n9, 1).Select
For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (planes 11, 12, 13 and 14)
750 n2 = n2 + 1
If n2 = 9 Then
n2 = 1: k1 = k1 + 20: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 5
End If
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 5, k2 + i2).Value = a(i3)
Next i2
Next i1
Cells(k1 + (i0 - 1) * 5, k2 + 1).Value = "Plane 1" + CStr(i0)
Next i0
Return
' Print results (3d)
760 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 29: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 17
End If
For i0 = 1 To 4
i3 = (4 - i0) * 16
For i1 = 1 To 4
For i2 = 1 To 4
i3 = i3 + 1
Cells(k1 + 1 + (i1 - 1) * 2 + (i0 - 1) * 7, k2 + 7 + (i2 - 1) * 3 - (i1 - 1) * 2).Value = a(i3)
Next i2
Next i1
Next i0
Return
End Sub
