'Permutate Squares within Sudoku Comparable Cubes (5 x 5 x 5)
' Tested with Office 2007 under Windows 7
Sub SudPerm5()
Dim a1(125), a2(5, 25), Prm5(24, 5), s3(4)
Prm5(1, 1) = 1: Prm5(1, 2) = 2: Prm5(1, 3) = 3: Prm5(1, 4) = 4: Prm5(1, 5) = 5:
Prm5(2, 1) = 1: Prm5(2, 2) = 2: Prm5(2, 3) = 3: Prm5(2, 4) = 5: Prm5(2, 5) = 4:
Prm5(3, 1) = 1: Prm5(3, 2) = 4: Prm5(3, 3) = 3: Prm5(3, 4) = 2: Prm5(3, 5) = 5:
Prm5(4, 1) = 1: Prm5(4, 2) = 4: Prm5(4, 3) = 3: Prm5(4, 4) = 5: Prm5(4, 5) = 2:
Prm5(5, 1) = 1: Prm5(5, 2) = 5: Prm5(5, 3) = 3: Prm5(5, 4) = 2: Prm5(5, 5) = 4:
Prm5(6, 1) = 1: Prm5(6, 2) = 5: Prm5(6, 3) = 3: Prm5(6, 4) = 4: Prm5(6, 5) = 2:
Prm5(7, 1) = 2: Prm5(7, 2) = 1: Prm5(7, 3) = 3: Prm5(7, 4) = 4: Prm5(7, 5) = 5:
Prm5(8, 1) = 2: Prm5(8, 2) = 1: Prm5(8, 3) = 3: Prm5(8, 4) = 5: Prm5(8, 5) = 4:
Prm5(9, 1) = 2: Prm5(9, 2) = 4: Prm5(9, 3) = 3: Prm5(9, 4) = 1: Prm5(9, 5) = 5:
Prm5(10, 1) = 2: Prm5(10, 2) = 4: Prm5(10, 3) = 3: Prm5(10, 4) = 5: Prm5(10, 5) = 1:
Prm5(11, 1) = 2: Prm5(11, 2) = 5: Prm5(11, 3) = 3: Prm5(11, 4) = 1: Prm5(11, 5) = 4:
Prm5(12, 1) = 2: Prm5(12, 2) = 5: Prm5(12, 3) = 3: Prm5(12, 4) = 4: Prm5(12, 5) = 1:
Prm5(13, 1) = 4: Prm5(13, 2) = 1: Prm5(13, 3) = 3: Prm5(13, 4) = 2: Prm5(13, 5) = 5:
Prm5(14, 1) = 4: Prm5(14, 2) = 1: Prm5(14, 3) = 3: Prm5(14, 4) = 5: Prm5(14, 5) = 2:
Prm5(15, 1) = 4: Prm5(15, 2) = 2: Prm5(15, 3) = 3: Prm5(15, 4) = 1: Prm5(15, 5) = 5:
Prm5(16, 1) = 4: Prm5(16, 2) = 2: Prm5(16, 3) = 3: Prm5(16, 4) = 5: Prm5(16, 5) = 1:
Prm5(17, 1) = 4: Prm5(17, 2) = 5: Prm5(17, 3) = 3: Prm5(17, 4) = 1: Prm5(17, 5) = 2:
Prm5(18, 1) = 4: Prm5(18, 2) = 5: Prm5(18, 3) = 3: Prm5(18, 4) = 2: Prm5(18, 5) = 1:
Prm5(19, 1) = 5: Prm5(19, 2) = 1: Prm5(19, 3) = 3: Prm5(19, 4) = 2: Prm5(19, 5) = 4:
Prm5(20, 1) = 5: Prm5(20, 2) = 1: Prm5(20, 3) = 3: Prm5(20, 4) = 4: Prm5(20, 5) = 2:
Prm5(21, 1) = 5: Prm5(21, 2) = 2: Prm5(21, 3) = 3: Prm5(21, 4) = 1: Prm5(21, 5) = 4:
Prm5(22, 1) = 5: Prm5(22, 2) = 2: Prm5(22, 3) = 3: Prm5(22, 4) = 4: Prm5(22, 5) = 1:
Prm5(23, 1) = 5: Prm5(23, 2) = 4: Prm5(23, 3) = 3: Prm5(23, 4) = 1: Prm5(23, 5) = 2:
Prm5(24, 1) = 5: Prm5(24, 2) = 4: Prm5(24, 3) = 3: Prm5(24, 4) = 2: Prm5(24, 5) = 1:
Sheets("Klad1").Select
Sht1 = "Solutions51"
n3 = 13441
n9 = 1
For j10 = 2 To n3
j3 = 0
For j1 = 1 To 5 'Load Cube
For j2 = 1 To 25
j3 = j3 + 1
a2(j1, j2) = Sheets(Sht1).Cells(j10, j3).Value
Next j2
Next j1
GoSub 100 'Write permutations
Next j10
End
' Write permutations
100
For j20 = 1 To 24
j3 = 0
For j1 = 1 To 5 'Construct Cube
j4 = Prm5(j20, j1)
For j2 = 1 To 25
j3 = j3 + 1
a1(j3) = a2(j4, j2)
Next j2
Next j1
' Check routine pan (diagonals)
GoSub 600 'Check Space Diogonals
If fl4 = 1 Then
n9 = n9 + 1: GoSub 500 'Print line format
End If
Next j20
Return
' Print Cube (line format)
500 Cells(n9, 125).Select
For i1 = 1 To 125
Cells(n9, i1).Value = a1(i1)
Next i1
Cells(n9, 127).Value = j10
Cells(n9, 128).Value = j20
Return
600 fl4 = 1
' Space Diagonals
s3(1) = a1(21) + a1(42) + a1(63) + a1(84) + a1(105):
s3(2) = a1(25) + a1(44) + a1(63) + a1(82) + a1(101):
s3(3) = a1(5) + a1(34) + a1(63) + a1(92) + a1(121):
s3(4) = a1(1) + a1(32) + a1(63) + a1(94) + a1(125):
For i1 = 1 To 4
If s3(i1) <> 10 Then fl4 = 0: Return
Next i1
Return
End Sub
