'Progetto - Condizione particolare di ambo ripetuto 2 - by Herat
'Script - by Salvo50
Option Explicit
Sub Main
TestoInBandaPassante "**Progetto CONDIZIONI PARTICOLARI DI AMBO RIPETUTO 2 - bY Herat , script by Salvo50 ** ",1,4,0
Dim fin,esq,col,esqcol,es,idestr
Dim r1,r2,p1,p2,p3,p4,caso,casi
Dim estr1,estr2,estr3,estr4
Dim xestr1,xestr2,xestr3,xestr4
Dim diffx2,diff1,diff2
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,8355) '9355 estrazione dell'esempio
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,5000))
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = Estratto(es,r1,p1)
estr2 = Estratto(es,r1,p2)
diff1 = Differenza(estr1,estr2)
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estr3 = Estratto(es,r2,p3)
estr4 = Estratto(es,r2,p4)
diff2 = Differenza(estr3,estr4)
If diff1 = diff2 Then
If estr1 = estr3 And estr2 = estr4 Or estr1 = estr4 And estr2 = estr3 Then
diffx2 = Fuori90(diff1 * 2)
If estr1 > estr2 Then
xestr1 = Fuori90(estr1 + diffx2)
xestr2 = Fuori90(xestr1 + diff1)
End If
If estr2 > estr1 Then
xestr1 = Fuori90(estr2 + diffx2)
xestr2 = Fuori90(xestr1 + diff1)
End If
'-------------------------------------
If estr3 < estr4 Then
xestr3 = Fuori90(90 +(estr3 - diffx2))
xestr4 = Fuori90(90 +(xestr3 - diff1))
End If
If estr4 < estr3 Then
xestr3 = Fuori90(estr4 - diffx2)
xestr4 = Fuori90(xestr3 - diff1)
End If
If Posizione(es,r1,xestr1) > 0 And Posizione(es,r1,xestr2) > 0 Xor _
Posizione(es,r1,xestr3) > 0 And Posizione(es,r1,xestr4) > 0 Xor _
Posizione(es,r2,xestr1) > 0 And Posizione(es,r2,xestr2) > 0 Xor _
Posizione(es,r2,xestr3) > 0 And Posizione(es,r2,xestr4) > 0 Then
casi = casi + 1
caso = caso + 1
ColoreTesto 1
Scrivi String(74,"*") & " Casi Totali " & FormattaStringa(casi,"0000")
Scrivi String(65,"*") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi("Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(es,r1),2
Scrivi Space(19) & " Seconda Ruota " & SiglaRuota(r2) & " " & StringaEstratti(es,r2),2
Scrivi
Scrivi Space(1) & "Ambi uguali" & Space(4) & "Differenza " & Space(4) & "Coppie da trov."
Scrivi" " & SiglaRuota(r1) & " " & Format2(estr1) & " " & Format2(estr2),0,0
Scrivi Space(10) & Format2(diff1) & Space(13) & Format2(xestr1) & " " & Format2(xestr2)
Scrivi" " & SiglaRuota(r2) & " " & Format2(estr3) & " " & Format2(estr4),0,0
Scrivi Space(10) & Format2(diff2) & Space(13) & Format2(xestr3) & " " & Format2(xestr4)
Scrivi
ColoreTesto 2
If Posizione(es,r1,xestr1) > 0 And Posizione(es,r1,xestr2) > 0 Then
Scrivi " Coppia trovata nella ruota di " & SiglaRuota(r1) & " " & Format2(xestr1) & " " & Format2(xestr2)
End If
Scrivi
If Posizione(es,r1,xestr3) > 0 And Posizione(es,r1,xestr4) > 0 Then
Scrivi " Coppia trovata nella ruota di " & SiglaRuota(r1) & " " & Format2(xestr3) & " " & Format2(xestr4)
End If
Scrivi
If Posizione(es,r2,xestr1) > 0 And Posizione(es,r2,xestr2) > 0 Then
Scrivi " Coppia trovata nella ruota di " & SiglaRuota(r2) & " " & Format2(xestr1) & " " & Format2(xestr2)
End If
Scrivi
If Posizione(es,r2,xestr3) > 0 And Posizione(es,r2,xestr4) > 0 Then
Scrivi " Coppia trovata nella ruota di " & SiglaRuota(r2) & " " & Format2(xestr3) & " " & Format2(xestr4)
End If
ColoreTesto 0
End If
End If
End If
Next
Next
Next
Next
Next
Next
Next
End Sub