' Combines 3th order Magic Cubes into 9th order Magic Cubes
' Tested with Office 2007 under Windows 7
Sub CnstrCbs9()
Dim M(27), B(27, 27), C(9, 9, 9), nB(27)
' M(j1) = Multiplier Cube j1 = element
' B(j2,j1) = Sub Cube j2 = cube nr
' j1 = element
' C(j1,j2,j3) = Composed Cube j1 = row
' j2 = column
' j3 = layer
' m1 = Selected Cube from Workheet "Cube3"
' nB(27) = Selected Cubes from Workheet "Cube3"
y = MsgBox("Locked", vbCritical, "Routine CnstrCbs9")
End
' m1 = 185 and nB(i) = 185 for i = 1 ... 27: Harvey Heinz's example
' Initialise
m1 = 109
nB(1) = 91: nB(2) = 1: nB(3) = 82: nB(4) = 56: nB(5) = 145: nB(6) = 172: nB(7) = 158: nB(8) = 34: nB(9) = 21:
nB(10) = 2: nB(11) = 30: nB(12) = 73: nB(13) = 37: nB(14) = 189: nB(15) = 168: nB(16) = 112: nB(17) = 141: nB(18) = 28:
nB(19) = 50: nB(20) = 6: nB(21) = 159: nB(22) = 151: nB(23) = 152: nB(24) = 64: nB(25) = 87: nB(26) = 107: nB(27) = 155:
n2 = 0: n9 = 0: k1 = 1: k2 = 1
' Load 3th order Magic Cubes
j10 = m1: GoSub 100 'Read Multiplier
For j1 = 1 To 27
j10 = nB(j1): j20 = j1: GoSub 200 'Read Base Cubes
Next j1
GoSub 300 'Print Input (3 plane view)
' Compose 9th order Magic Cube
Sheets("Constr9").Select
n9 = 1
i4 = 0: i1 = -2
For j1 = 1 To 3
i1 = i1 + 3
i2 = -2
For j2 = 1 To 3
i2 = i2 + 3
i3 = -2
For j3 = 1 To 3
i3 = i3 + 3
i4 = i4 + 1: GoSub 500 'Fill 9th order Magic Cube
Next j3
Next j2
Next j1
GoSub 800 'Print 9th order Magic Cube
End
' Read 3th order Multiplier (line format)
100 For i1 = 1 To 27
M(i1) = Sheets("Cubes3").Cells(j10, i1).Value
Next i1
Return
' Read 3th order Base Cubes (line format)
200 For i1 = 1 To 27
B(j20, i1) = Sheets("Cubes3").Cells(j10, i1).Value
Next i1
Return
' Print Input (3 plane view)
300 Sheets("Input3").Select
n9 = 0
For j20 = 1 To 27
n9 = n9 + 1: GoSub 650 'Print Base Cubes
Next j20
n9 = 0: GoSub 700 'Print Multiplier
Return
' Fill 9th order Magic Cube
500 i10 = i1 - 1: i20 = i2 - 1: i30 = i3 - 1: i40 = 0
For j10 = 1 To 3
i10 = i10 + 1
For j20 = 1 To 3
i20 = i20 + 1
For j30 = 1 To 3
i30 = i30 + 1
i40 = i40 + 1
C(i10, i20, i30) = B(i4, i40) + (M(i4) - 1) * 27
Next j30
i30 = i3 - 1
Next j20
i20 = i2 - 1
Next j10
Return
' Print 3th order Magic Cubes (planes 1, 2 and 3)
650 n2 = n2 + 1
If n2 = 4 Then
n2 = 1: k1 = k1 + 12: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 4
End If
Cells(k1, k2 + 1).Value = "Base " + CStr(n9)
For i0 = 1 To 3
i3 = (i0 - 1) * 9
For i1 = 1 To 3
For i2 = 1 To 3
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 4, k2 + i2).Value = B(j20, i3)
Next i2
Next i1
Next i0
Return
700 n2 = 1: k1 = 1: k2 = 13
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = "Multiplier"
For i0 = 1 To 3
i3 = (i0 - 1) * 9
For i1 = 1 To 3
For i2 = 1 To 3
i3 = i3 + 1
Cells(k1 + i1 + (i0 - 1) * 4, k2 + i2).Value = M(i3)
Next i2
Next i1
Next i0
Return
' Print 9th order Magic Cubes (planes 1, 2 ... 9)
800 n2 = 1: k1 = 1: k2 = 1
For i0 = 1 To 9
For i1 = 1 To 9
For i2 = 1 To 9
Cells(k1 + i1 + (i0 - 1) * 10, k2 + i2).Value = C(i0, i1, i2)
Next i2
Next i1
Next i0
Return
End Sub
' Random Selection Sub Cubes (28 is Multiplier Cube)
Sub SlctCbs3()
Sheets("Klad1").Select
n2 = 192
For j2 = 1 To 28
n1 = 1 + Int(n2 * Rnd): If n1 = n2 + 1 Then n1 = n2
Cells(j2, 1).Value = j2
Cells(j2, 2).Value = n1
Next j2
End Sub
