' Construct Generators for Squares of Subtraction (10 x 10)
' Consecutive Integers (Medjig Lines)
' Tested with Office 365 under Windows 10
Sub CnstrGen10a()
Dim a(100), a1(100), a2(100), nRw(10), b(100)
y = MsgBox("Blocked", vbInformation, "CnstrGen10a")
End
Sheets("Klad1").Select
n1 = 0: n9 = 0: k1 = 1: k2 = 1
n0 = 1: n8 = 872: n81 = 65
ShtNm1 = "MedLns10"
For j1 = n0 To n81
Cells(1, 1).Value = j1
t11 = Timer 'Time Out
n10 = 10: Erase a
For i1 = 1 To 10
a1(i1) = Sheets(ShtNm1).Cells(j1, i1).Value
Next i1
nRw(1) = j1
For i1 = 1 To 10 'First Line
a(i1) = a1(i1)
Next i1
GoSub 200 'Remainder of Lines
'' If fl2 = 0 Then GoTo 10 'Not Found, Try Next
'' n9 = n9 + 1: GoSub 650:
n10 = n10 - 10
10 Next j1
End
200 fl2 = 0
For j2 = n81 + 1 To n8
j100 = j2: j101 = 2: GoSub 100: If fl1 = 0 Then GoTo 20
nRw(2) = j2
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j3 = j2 + 1 To n8
j100 = j3: j101 = 3: GoSub 100: If fl1 = 0 Then GoTo 30
nRw(3) = j3
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j4 = j3 + 1 To n8
j100 = j4: j101 = 4: GoSub 100: If fl1 = 0 Then GoTo 40
nRw(4) = j4
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j5 = j4 + 1 To n8
j100 = j5: j101 = 5: GoSub 100: If fl1 = 0 Then GoTo 50
nRw(5) = j5
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j6 = j5 + 1 To n8
j100 = j6: j101 = 6: GoSub 100: If fl1 = 0 Then GoTo 60
nRw(6) = j6
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j7 = j6 + 1 To n8
j100 = j7: j101 = 7: GoSub 100: If fl1 = 0 Then GoTo 70
nRw(7) = j7
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j8 = j7 + 1 To n8
j100 = j8: j101 = 8: GoSub 100: If fl1 = 0 Then GoTo 80
nRw(8) = j8
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j9 = j8 + 1 To n8
j100 = j9: j101 = 9: GoSub 100: If fl1 = 0 Then GoTo 90
nRw(9) = j9
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
For j10 = j9 + 1 To n8
j100 = j10: j101 = 10: GoSub 100: If fl1 = 0 Then GoTo 105
nRw(10) = j10
t12 = Timer: t13 = t12 - t11 'Time Out
If t13 > 60 Then Return 'Time Out, Try Next
n9 = n9 + 1: GoSub 650: ''End
'' fl2 = 1
'' Return
n10 = n10 - 10
105 Next j10
n10 = n10 - 10
90 Next j9
n10 = n10 - 10
80 Next j8
n10 = n10 - 10
70 Next j7
n10 = n10 - 10
60 Next j6
n10 = n10 - 10
50 Next j5
n10 = n10 - 10
40 Next j4
n10 = n10 - 10
30 Next j3
n10 = n10 - 10
20 Next j2
Return
''
100 fl1 = 1
For i1 = 1 To 10
a2(i1) = Sheets(ShtNm1).Cells(j100, i1).Value
Next i1
For i1 = 1 To 10
a20 = a2(i1)
For i2 = 1 To n10
If a20 = a(i2) Then fl1 = 0: Return
'' If a20 = 101 - a(i2) Then fl1 = 0: Return 'Check Complement
Next i2
Next i1
n10 = n10 + 10
i2 = 0
For i1 = n10 - 10 + 1 To n10
i2 = i2 + 1
a(i1) = a2(i2)
Next i1
Return
' Print Results (lines)
655 For i1 = 1 To 100
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 101).Value = n9
Cells(1, 102).Value = n9
Return
' Print Results (Squares)
650 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 = n9
i3 = 0
For i1 = 1 To 10
For i2 = 1 To 10
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
' Row Number
Cells(k1 + i1, k2 + 11).Value = nRw(i1)
Next i1
Return
End Sub
