Per Salvo50 ottimizzazione script

[sorujoe]

Ciao Amicone ti volevo chiedere se puoi immettermi su questo script tale ottimizzazione.
A me servirebbe che mi facesse alla fine dell'output il riepilogo per ciascuna delle 2 somme da me immesse; ....esempio somma 20 e 35

somma 20 trovata 11 volte
somma 35 trovata 13 volte
(la somma include anche le frequenze sulla ruota fissata da me)

se poi mi facesse la distribuzione sulle varie ruote (includendo quella fissa da me scelta) sarebbe ideale

esempio delle 11 frequenze della somma 20
Bari: 8
Cagliari: 2
Milano 1
Totale: 11



lo script è questo

Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,Salvo50,E1,E2,S1,S2,S3
Dim R1,R2,P1,P2,P3,P4,P5,P6,P7,A,B,C,D,E,Dist
Dim VertS3,CaS3,CaVertS3,Caso,Casi,X,Y,OK
Dim Posta(2),Ruote(2),Poste(5),Num(8),Nu(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9500)
R1 = InputBox("INSERISCI IL NUMERO DELLA 1ª RUOTA",,1)
P1 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,1)
P2 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,2)
P3 = InputBox("INSERISCI IL 3° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,3)
R2 = InputBox("INSERISCI IL NUMERO DELLA 2ª RUOTA",,2)
P4 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,1)
P5 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,5)
Dist = CInt(InputBox("QUALE DISTANZA VUOI CALCOLARE IN PIU' OPPURE MENO ",,1))
If R1 <> R2 And P1 <> P2 And P1 <> P3 And P2 <> P3 And P4 <> P5 Then
Clp1 = InputBox("Per quanti colpi vuoi giocare l'ottina?",,7)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(12) & "PER BYRON - SCRIPT Salvo50",1,,4,,3,,1
Posta(1) = 1
Posta(2) = 1
Poste(2) = 1
Poste(3) = 1
'Poste(4) = 1
'Poste(5) = 1
Ruote(1) = R1
Ruote(2) = R2
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
OK = 0
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
C = Estratto(Es,R1,P3)
D = Estratto(Es,R2,P4)
E = Estratto(Es,R2,P5)
If A And D > 0 Then
S1 = Fuori90(A + B)
S2 = Fuori90(B + C)
S3 = Fuori90(S1 + S2)
VertS3 = Vert(S3)
CaS3 = Cadenza(S3)
CaVertS3 = Cadenza(VertS3)
If Not Gemello(S3) And Not Gemello(VertS3) And CaS3 <> 9 And CaVertS3 <> 9 Then
Nu(1) = S3 : Nu(2) = VertS3
If SerieFreqTurbo(Es,Es,Nu,Ruote,1) = 0 Then
Num(1) = S3
Num(2) = VertS3
Num(3) = Fuori90(90 +(D - Dist))
Num(4) = D
Num(5) = Fuori90(D + Dist)
Num(6) = Fuori90(90 +(E - Dist))
Num(7) = E
Num(8) = Fuori90(E + Dist)
OK = 1
If NumeriRipetuti(Num) Then OK = 0
If OK = 1 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
If E1 = A Or E1 = B Or E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = D Or E2 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(12) & " PIRAMIDE",1,,,2
Scrivi Space(12) & Format2(A) & " " & Format2(B) & " " & Format2(C),1
Scrivi Space(14) & Format2(S1) & " " & Format2(S2),1
Scrivi Space(16) & Format2(S3),1
Scrivi
ImpostaGiocata 1,Nu,Ruote,Posta,Clp1
ImpostaGiocata 2,Num,Ruote,Poste,Clp1
Gioca Es
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End If
If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI ",1,,,2
If P1 = P2 Or P1 = P3 Or P2 = P3 Then Scrivi " HAI INSERITO 2 O PIU' POSIZIONI UGUALI NELLA 1ª RUOTA",1,,,2
If P4 = P5 Then Scrivi " HAI INSERITO 2 POSIZIONI UGUALI NELLA 2ª RUOTA",1,,,2
End Sub

 

[salvo50]

Ciao a Tutti.

Ciao Byron, sei sicuro che è questo lo script da ottimizzare?
Da nessuna parte vedo inserimenti di somme da cercare.

Metti lo script giusto e poi non garantisco niente, ti avevo già
scritto in un altro post,(che non riesco a trovare) che con le
frequenze e ritardi non ci vado d'accordo

 

[sorujoe]

è questo

Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Salvo50,Sp,R1,R2,P1,Caso,Casi
Dim A(5),B(5),AB(5),k1,E1,C,D
Sp = " "
C = 71 : D = 81
FIn = EstrazioneFin
Ini = FIn - 18
R1 = CInt(InputBox("INSERISCI IL NUMERO DELLA RUOTA",Salvo50,1))
C = CInt(InputBox("INSERISCI LA PRIMA SOMMA CHE VUOI EVIDENZIARE",Salvo50,59))
D = CInt(InputBox("INSERISCI LA SECONDA SOMMA CHE VUOI EVIDENZIARE",Salvo50,71))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(12) & "PER BYRON -SOMME ISOTOPE - SCRIPT SALVO50",1,,4,,3,,1
For Es = Ini To FIn
Caso = 0
Messaggio Es
AvanzamentoElab Ini,FIn,Es
For R2 = 1 To 12
If R2 = 11 Then R2 = 12
If R2 <> R1 Then
For P1 = 1 To 5
A(P1) = Estratto(Es,R1,P1)
B(P1) = Estratto(Es,R2,P1)
AB(P1) = Fuori90(A(P1) + B(P1))
Next
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) & " " & StringaEstratti(Es,R1),1,,,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1,,,1
Scrivi
Scrivi Space(13) & " Somma estratti isotopi ",1,0
For k1 = 1 To 5
E1 = AB(k1)
If E1 = C Or E1 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
End If
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub