Vorige Pagina About the Author

' 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

Vorige Pagina About the Author