Option Explicit
Sub Main
Dim FIn,Ini,Es,Salvo50,Caso,Casi,K
Dim EstA,EstB,EstC,EstD,Sp,AA,BB,CC,DD,EE,FF,GG,HH
Dim R1,R2,A,B,C,D,E,F,G,H,P1,P2,P5,P6,E1,E2,OK
Sp = " "
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,8515) '8517 ESEMPIO NELLE SPIEGAZIONI
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(8) & "Quartine Fabarri e Simmetriche - INCOMPLETO - ABBOZZO SALVO50",1,,4,,3,,1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
EstA = Estratto(Es,R1,P1)
EstB = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
EstC = Estratto(Es - 1,R2,P1)
EstD = Estratto(Es - 1,R2,P2)
If(EstA <> EstC) And(EstA <> EstD)And(EstB <> EstC) And(EstB <> EstD)Then
A = 0 : B = 45 : C = 45 : D = 90 : E = 0 : F = 46 : G = 45 : H = 91
'-------------------------------
For K = 1 To 22
A = A + 1
B = B + 1
C = C - 1
D = D - 1
E = E + 1
F = F - 1
G = G + 1
H = H - 1
OK = 0
If(A = EstA And E = EstB) Or(A = EstA And F = EstB) Or(A = EstA And G = EstB) Or(A = EstA And H = EstB) _
Or(B = EstA And E = EstB) Or(B = EstA And F = EstB) Or(B = EstA And G = EstB) Or(B = EstA And H = EstB) _
Or(C = EstA And E = EstB) Or(C = EstA And F = EstB) Or(C = EstA And G = EstB) Or(C = EstA And H = EstB) _
Or(D = EstA And E = EstB) Or(D = EstA And F = EstB) Or(D = EstA And G = EstB) Or(D = EstA And H = EstB) Then OK = 1
Next
'-------------------------------
If OK = 1 Then
AA = 0 : BB = 45 : CC = 45 : DD = 90 : EE = 0 : FF = 46 : GG = 45 : HH = 91
K = 0
For K = 1 To 22
AA = AA + 1
BB = BB + 1
CC = CC - 1
DD = DD - 1
EE = EE + 1
FF = FF - 1
GG = GG + 1
HH = HH - 1
If(AA = EstC And EE = EstD) Or(AA = EstC And FF = EstD) Or(AA = EstC And GG = EstD) Or(AA = EstC And HH = EstD) _
Or(BB = EstC And EE = EstD) Or(BB = EstC And FF = EstD) Or(BB = EstC And GG = EstD) Or(BB = EstC And HH = EstD) _
Or(CC = EstC And EE = EstD) Or(CC = EstC And FF = EstD) Or(CC = EstC And GG = EstD) Or(CC = EstC And HH = EstD) _
Or(DD = EstC And EE = EstD) Or(DD = EstC And FF = EstD) Or(DD = EstC And GG = EstD) Or(DD = EstC And HH = EstD) Then OK = 2 '
If OK = 2 Then Exit For
Next
If OK = 2 Then
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es,R1,P5)
If E1 = EstA Or E1 = EstB Then ColoreTesto 2 Else ColoreTesto 0
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es - 1) & " del " & DataEstrazione(Es - 1)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P6 = 1 To 5
E2 = Estratto(Es - 1,R2,P6)
If E2 = EstC Or E2 = EstD Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
A = 0 : B = 45 : C = 45 : D = 90 : E = 0 : F = 46 : G = 45 : H = 91
K = 0
Scrivi " Quartine" & Space(7) & "Quartine ",1
Scrivi " Fabarri" & Space(7) & "Simmetriche ",1
For K = 1 To 22
A = A + 1
B = B + 1
C = C - 1
D = D - 1
E = E + 1
F = F - 1
G = G + 1
H = H - 1
Scrivi Format2(A) & Sp & Format2(B) & Sp & Format2(C) & Sp & Format2(D) & Space(5),1,0
Scrivi Format2(E) & Sp & Format2(F) & Sp & Format2(G) & Sp & Format2(H),1
Next
End If
End If
End If
Next
Next
Next
Next
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
EstA = Estratto(Es,R1,P1)
EstB = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
EstC = Estratto(Es + 1,R2,P1)
EstD = Estratto(Es + 1,R2,P2)
If(EstA <> EstC) And(EstA <> EstD)And(EstB <> EstC) And(EstB <> EstD)Then
A = 0 : B = 45 : C = 45 : D = 90 : E = 0 : F = 46 : G = 45 : H = 91
'-------------------------------
For K = 1 To 22
A = A + 1
B = B + 1
C = C - 1
D = D - 1
E = E + 1
F = F - 1
G = G + 1
H = H - 1
OK = 0
If(A = EstA And E = EstB) Or(A = EstA And F = EstB) Or(A = EstA And G = EstB) Or(A = EstA And H = EstB) _
Or(B = EstA And E = EstB) Or(B = EstA And F = EstB) Or(B = EstA And G = EstB) Or(B = EstA And H = EstB) _
Or(C = EstA And E = EstB) Or(C = EstA And F = EstB) Or(C = EstA And G = EstB) Or(C = EstA And H = EstB) _
Or(D = EstA And E = EstB) Or(D = EstA And F = EstB) Or(D = EstA And G = EstB) Or(D = EstA And H = EstB) Then OK = 1
Next
'-------------------------------
If OK = 1 Then
AA = 0 : BB = 45 : CC = 45 : DD = 90 : EE = 0 : FF = 46 : GG = 45 : HH = 91
K = 0
For K = 1 To 22
AA = AA + 1
BB = BB + 1
CC = CC - 1
DD = DD - 1
EE = EE + 1
FF = FF - 1
GG = GG + 1
HH = HH - 1
If(AA = EstC And EE = EstD) Or(AA = EstC And FF = EstD) Or(AA = EstC And GG = EstD) Or(AA = EstC And HH = EstD) _
Or(BB = EstC And EE = EstD) Or(BB = EstC And FF = EstD) Or(BB = EstC And GG = EstD) Or(BB = EstC And HH = EstD) _
Or(CC = EstC And EE = EstD) Or(CC = EstC And FF = EstD) Or(CC = EstC And GG = EstD) Or(CC = EstC And HH = EstD) _
Or(DD = EstC And EE = EstD) Or(DD = EstC And FF = EstD) Or(DD = EstC And GG = EstD) Or(DD = EstC And HH = EstD) Then OK = 2 '
'If OK = 2 Then Exit For
Next
If OK = 2 Then
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es,R1,P5)
If E1 = EstA Or E1 = EstB Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazione(Es + 1)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P6 = 1 To 5
E2 = Estratto(Es + 1,R2,P6)
If E2 = EstC Or E2 = EstD Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
A = 0 : B = 45 : C = 45 : D = 90 : E = 0 : F = 46 : G = 45 : H = 91
K = 0
Scrivi " Quatine" & Space(8) & "Quartine ",1
Scrivi " Fabarri" & Space(7) & "Simmetriche ",1
For K = 1 To 22
A = A + 1
B = B + 1
C = C - 1
D = D - 1
E = E + 1
F = F - 1
G = G + 1
H = H - 1
Scrivi Format2(A) & Sp & Format2(B) & Sp & Format2(C) & Sp & Format2(D) & Space(5),1,0
Scrivi Format2(E) & Sp & Format2(F) & Sp & Format2(G) & Sp & Format2(H),1
Next
End If
End If
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub