' Generates Semi Latin Associated Borders (10 x 10)
' Tested with Office 365 under Windows 10
Sub AssBrd10()
Dim a(100), a1(4), b(10), b1(100), c(100)
y = MsgBox("Locked", vbCritical, "Routine AssBrdr10")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m11 = 1: m12 = 10: s1 = 45: p10 = 9
a1(1) = 0: a1(2) = 1: a1(3) = 8: a1(4) = 9
m21 = 1: m22 = 4
' Define Center Square
c(23) = 78: c(24) = 33: c(25) = 58: c(26) = 25: c(27) = 63: c(28) = 46:
c(33) = 44: c(34) = 67: c(35) = 24: c(36) = 74: c(37) = 37: c(38) = 57:
c(43) = 53: c(44) = 36: c(45) = 45: c(46) = 28: c(47) = 66: c(48) = 75:
c(53) = 26: c(54) = 35: c(55) = 73: c(56) = 56: c(57) = 65: c(58) = 48:
c(63) = 47: c(64) = 64: c(65) = 27: c(66) = 77: c(67) = 34: c(68) = 54:
c(73) = 55: c(74) = 68: c(75) = 76: c(76) = 43: c(77) = 38: c(78) = 23:
' Generate Borders
Sheets("Klad1").Select
t1 = Timer
For j100 = m21 To m22
a(100) = a1(j100)
a(1) = s1 / 5 - a(100)
For j99 = m11 To m12
a(99) = j99 - 1
a(2) = s1 / 5 - a(99)
For j98 = m21 To m22
a(98) = a1(j98)
a(3) = s1 / 5 - a(98)
For j97 = m21 To m22
a(97) = a1(j97)
a(4) = s1 / 5 - a(97)
For j96 = m21 To m22
a(96) = a1(j96)
a(5) = s1 / 5 - a(96)
For j95 = m21 To m22
a(95) = a1(j95)
If a(95) = a(5) Then GoTo 950
a(6) = s1 / 5 - a(95)
If a(96) = a(6) Then GoTo 950
For j94 = m21 To m22
a(94) = a1(j94)
If a(94) = a(4) Then GoTo 940
a(7) = s1 / 5 - a(94)
If a(97) = a(7) Then GoTo 940
For j93 = m21 To m22
a(93) = a1(j93)
If a(93) = a(3) Then GoTo 930
a(8) = s1 / 5 - a(93)
If a(98) = a(8) Then GoTo 930
For j92 = m11 To m12
a(92) = j92 - 1
If a(92) = a(2) Then GoTo 920
a(9) = s1 / 5 - a(92)
If a(99) = a(9) Then GoTo 920
a(91) = s1 - a(92) - a(93) - a(94) - a(95) - a(96) - a(97) - a(98) - a(99) - a(100)
If a(91) <> 0 And a(91) <> 1 And a(91) <> 8 And a(91) <> 9 Then GoTo 920
If a(91) = a(1) Then GoTo 920
a(10) = s1 / 5 - a(91)
If a(100) = a(10) Then GoTo 920
For j90 = m11 To m12
a(90) = j90 - 1
If a(90) = a(100) Or a(90) = a(10) Then GoTo 900
a(11) = s1 / 5 - a(90)
If a(11) = a(91) Or a(11) = a(1) Then GoTo 900
For j89 = m21 To m22
a(89) = a1(j89)
If a(89) = a(99) Or a(89) = a(9) Then GoTo 890
If a(89) = a(100) Or a(89) = a(1) Then GoTo 890 'Diagonal
a(12) = s1 / 5 - a(89)
If a(12) = a(92) Or a(12) = a(2) Then GoTo 890
For j88 = m21 To m22
a(88) = a1(j88)
If a(88) = a(98) Or a(88) = a(8) Then GoTo 880
a(13) = s1 / 5 - a(88)
If a(13) = a(93) Or a(13) = a(3) Then GoTo 880
For j87 = m21 To m22
a(87) = a1(j87)
If a(87) = a(97) Or a(87) = a(7) Then GoTo 870
a(14) = s1 / 5 - a(87)
If a(14) = a(94) Or a(14) = a(4) Then GoTo 870
For j86 = m21 To m22
a(86) = a1(j86)
If a(86) = a(96) Or a(86) = a(6) Then GoTo 860
a(15) = s1 / 5 - a(86)
If a(15) = a(95) Or a(15) = a(5) Then GoTo 860
a(85) = a(86) - a(95) + a(96)
If a(85) <> 0 And a(85) <> 1 And a(85) <> 8 And a(85) <> 9 Then GoTo 860
If a(85) = a(95) Or a(85) = a(5) Or a(85) = a(15) Then GoTo 860
a(16) = s1 / 5 - a(85)
If a(16) = a(96) Or a(16) = a(86) Or a(16) = a(6) Then GoTo 860
a(84) = a(87) - a(94) + a(97)
If a(84) <> 0 And a(84) <> 1 And a(84) <> 8 And a(84) <> 9 Then GoTo 860
If a(84) = a(94) Or a(84) = a(4) Or a(84) = a(14) Then GoTo 860
a(17) = s1 / 5 - a(84)
If a(17) = a(97) Or a(17) = a(87) Or a(17) = a(7) Then GoTo 860
a(83) = a(88) - a(93) + a(98)
If a(83) <> 0 And a(83) <> 1 And a(83) <> 8 And a(83) <> 9 Then GoTo 860
If a(83) = a(93) Or a(83) = a(3) Or a(83) = a(13) Then GoTo 860
a(18) = s1 / 5 - a(83)
If a(18) = a(98) Or a(18) = a(88) Or a(18) = a(8) Then GoTo 860
For j82 = m21 To m22
a(82) = a1(j82)
If a(82) = a(92) Or a(82) = a(2) Or a(82) = a(12) Then GoTo 820
If a(82) = a(91) Or a(82) = a(10) Then GoTo 820 'Diagonal
a(19) = s1 / 5 - a(82)
If a(19) = a(99) Or a(19) = a(89) Or a(19) = a(9) Then GoTo 820
a(81) = s1 - a(82) - a(83) - a(84) - a(85) - a(86) - a(87) - a(88) - a(89) - a(90)
If a(81) < 0 Or a(81) > 9 Then GoTo 820
If a(81) = a(91) Or a(81) = a(1) Or a(81) = a(11) Then GoTo 820
a(20) = s1 / 5 - a(81)
If a(20) = a(100) Or a(20) = a(90) Or a(20) = a(10) Then GoTo 820
For j80 = m11 To m12
a(80) = j80 - 1
If a(80) = a(10) Or a(80) = a(20) Or a(80) = a(90) Or a(80) = a(100) Then GoTo 800
a(21) = s1 / 5 - a(80)
If a(21) = a(1) Or a(21) = a(11) Or a(21) = a(81) Or a(21) = a(91) Then GoTo 800
For j79 = m11 To m12
a(79) = j79 - 1
If a(79) = a(9) Or a(79) = a(19) Or a(79) = a(89) Or a(79) = a(99) Then GoTo 790
a(22) = s1 / 5 - a(79)
If a(22) = a(2) Or a(22) = a(12) Or a(22) = a(82) Or a(22) = a(92) Then GoTo 790
For j72 = m11 To m12
a(72) = j72 - 1
If a(72) = a(2) Or a(72) = a(12) Or a(72) = a(82) Or a(72) = a(92) Or a(72) = a(22) Then GoTo 720
a(29) = s1 / 5 - a(72)
If a(29) = a(9) Or a(29) = a(19) Or a(29) = a(79) Or a(29) = a(89) Or a(29) = a(99) Then GoTo 720
a(71) = 2 * s1 / 5 - a(72) - a(79) - a(80)
If a(71) < 0 Or a(71) > 9 Then GoTo 720
If a(71) = a(1) Or a(71) = a(11) Or a(71) = a(81) Or a(71) = a(91) Or a(71) = a(21) Then GoTo 720
a(30) = s1 / 5 - a(71)
If a(30) = a(10) Or a(30) = a(20) Or a(30) = a(80) Or a(30) = a(90) Or a(30) = a(100) Then GoTo 720
For j70 = m11 To m12
a(70) = j70 - 1
If a(70) = a(10) Or a(70) = a(20) Or a(70) = a(30) Then GoTo 700
If a(70) = a(80) Or a(70) = a(90) Or a(70) = a(100) Then GoTo 700
a(31) = s1 / 5 - a(70)
If a(31) = a(1) Or a(31) = a(11) Or a(31) = a(21) Then GoTo 700
If a(31) = a(71) Or a(31) = a(81) Or a(31) = a(91) Then GoTo 700
For j69 = m11 To m12
a(69) = j69 - 1
If a(69) = a(9) Or a(69) = a(19) Or a(69) = a(29) Then GoTo 690
If a(69) = a(79) Or a(69) = a(89) Or a(69) = a(99) Then GoTo 690
a(32) = s1 / 5 - a(69)
If a(32) = a(2) Or a(32) = a(12) Or a(32) = a(22) Then GoTo 700
If a(32) = a(72) Or a(32) = a(82) Or a(32) = a(92) Then GoTo 700
For j62 = m11 To m12
a(62) = j62 - 1
If a(62) = a(2) Or a(62) = a(12) Or a(62) = a(22) Or a(62) = a(32) Then GoTo 700
If a(62) = a(72) Or a(62) = a(82) Or a(62) = a(92) Then GoTo 700
a(39) = s1 / 5 - a(62)
If a(39) = a(9) Or a(39) = a(19) Or a(39) = a(29) Then GoTo 700
If a(39) = a(69) Or a(39) = a(79) Or a(39) = a(89) Or a(39) = a(99) Then GoTo 700
a(61) = 2 * s1 / 5 - a(62) - a(69) - a(70)
If a(61) < 0 Or a(61) > 9 Then GoTo 620
If a(61) = a(1) Or a(61) = a(11) Or a(61) = a(21) Or a(61) = a(31) Then GoTo 700
If a(61) = a(71) Or a(61) = a(81) Or a(61) = a(91) Then GoTo 700
a(40) = s1 / 5 - a(61)
If a(40) = a(10) Or a(40) = a(20) Or a(40) = a(30) Then GoTo 700
If a(40) = a(70) Or a(40) = a(80) Or a(40) = a(90) Or a(40) = a(100) Then GoTo 700
For j60 = m11 To m12
a(60) = j60 - 1
a(59) = 8 * s1 / 5 - a(60)-a(69)-a(70)-a(79)-a(80)-a(86)-a(87)-a(88)-a(89)-a(90)-a(96)-a(97)-a(98)-a(99)-a(100)
If a(59) < 0 Or a(59) > 9 Then GoTo 600
a(52) = a(59) - a(62) + a(69) - a(72) + a(79) - a(82) + a(89) - a(92) + a(99)
If a(52) < 0 Or a(52) > 9 Then GoTo 600
a(51) = 2 * s1 / 5 - a(52) - a(59) - a(60)
If a(51) < 0 Or a(51) > 9 Then GoTo 600
a(41) = s1 / 5 - a(60)
a(42) = s1 / 5 - a(59)
a(49) = s1 / 5 - a(52)
a(50) = s1 / 5 - a(51)
GoSub 1600: If fl1 = 0 Then GoTo 600 'Check Latin Columns
GoSub 500: If fl1 = 0 Then GoTo 600 'Determine Orthogonal Set
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
' Cells(1, 1).Value = n9 'Counting
600 Next j60
620 Next j62
690 Next j69
700 Next j70
720 Next j72
790 Next j79
800 Next j80
820 Next j82
860 Next j86
870 Next j87
880 Next j88
890 Next j89
900 Next j90
920 Next j92
930 Next j93
940 Next j94
950 Next j95
960 Next j96
970 Next j97
980 Next j98
990 Next j99
1000 Next j100
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine AssBrdr10")
End
' Compose Border
500 fl1 = 1
' Transpose a()
b1(1) = a(1): b1(2) = a(11): b1(3) = a(21): b1(4) = a(31): b1(5) = a(41):
b1(6) = a(51): b1(7) = a(61): b1(8) = a(71): b1(9) = a(81): b1(10) = a(91):
b1(11) = a(2): b1(12) = a(12): b1(13) = a(22): b1(14) = a(32): b1(15) = a(42):
b1(16) = a(52): b1(17) = a(62): b1(18) = a(72): b1(19) = a(82): b1(20) = a(92):
b1(21) = a(3): b1(22) = a(13): b1(23) = a(23): b1(24) = a(33): b1(25) = a(43):
b1(26) = a(53): b1(27) = a(63): b1(28) = a(73): b1(29) = a(83): b1(30) = a(93):
b1(31) = a(4): b1(32) = a(14): b1(33) = a(24): b1(34) = a(34): b1(35) = a(44):
b1(36) = a(54): b1(37) = a(64): b1(38) = a(74): b1(39) = a(84): b1(40) = a(94):
b1(41) = a(5): b1(42) = a(15): b1(43) = a(25): b1(44) = a(35): b1(45) = a(45):
b1(46) = a(55): b1(47) = a(65): b1(48) = a(75): b1(49) = a(85): b1(50) = a(95):
b1(51) = a(6): b1(52) = a(16): b1(53) = a(26): b1(54) = a(36): b1(55) = a(46):
b1(56) = a(56): b1(57) = a(66): b1(58) = a(76): b1(59) = a(86): b1(60) = a(96):
b1(61) = a(7): b1(62) = a(17): b1(63) = a(27): b1(64) = a(37): b1(65) = a(47):
b1(66) = a(57): b1(67) = a(67): b1(68) = a(77): b1(69) = a(87): b1(70) = a(97):
b1(71) = a(8): b1(72) = a(18): b1(73) = a(28): b1(74) = a(38): b1(75) = a(48):
b1(76) = a(58): b1(77) = a(68): b1(78) = a(78): b1(79) = a(88): b1(80) = a(98):
b1(81) = a(9): b1(82) = a(19): b1(83) = a(29): b1(84) = a(39): b1(85) = a(49):
b1(86) = a(59): b1(87) = a(69): b1(88) = a(79): b1(89) = a(89): b1(90) = a(99):
b1(91) = a(10): b1(92) = a(20): b1(93) = a(30): b1(94) = a(40): b1(95) = a(50):
b1(96) = a(60): b1(97) = a(70): b1(98) = a(80): b1(99) = a(90): b1(100) = a(100):
' Determine Border c()
For i1 = 1 To 100
If (i1 >= 23 And i1 <= 28) Then GoTo 520
If (i1 >= 33 And i1 <= 38) Then GoTo 520
If (i1 >= 43 And i1 <= 48) Then GoTo 520
If (i1 >= 53 And i1 <= 58) Then GoTo 520
If (i1 >= 63 And i1 <= 68) Then GoTo 520
If (i1 >= 73 And i1 <= 78) Then GoTo 520
c(i1) = a(i1) + 10 * b1(i1) + 1
520 Next i1
' Check Identical Numbers
For j1 = 1 To 100
c2 = c(j1):
For j2 = (1 + j1) To 100
If c2 = c(j2) Then fl1 = 0: Return
Next j2
510 Next j1
Return
' Check Columns 1, 2, 9, 10
1600 fl1 = 1
For i2 = 1 To 10
If i2 > 2 And i2 < 9 Then GoTo 1610
For i1 = 1 To 10:
b(i1) = a(i2): i2 = i2 + 10
Next i1
GoSub 1800: If fl1 = 0 Then Return
1610 Next i2
Return
' Exclude solutions with identical numbers Latin Lines Order 10
1800 fl1 = 1
For j1 = 1 To 10
a2 = b(j1):
For j2 = (1 + j1) To 10
If a2 = b(j2) Then fl1 = 0: Return
Next j2
1810 Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 100
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 11: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 11
End If
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 10
For i2 = 1 To 10
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3) ''c(i3)
Next i2
Next i1
Return
End Sub
