Per Salvo50 - The best

[sorujoe]

Salvo ti chiedo cortesemente tale script appena è nelle tue possibilità tempo permettendo.

Io indico 1 ruota di calcolo su di essa devo immettere:
a. una posizione e la figura della medesima (esempio posizione 1 di figura 5)
b. una seconda posizione e la figura della medesima (esempio posizione 2 di figura 5)
c. una terza posizione e la figura della medesima (esempio posizione 3 di figura 9)

Poi indico la seconda ruota di gioco (la prima è quella di calcolo) ...può essere anche la nazionale.
Una lunghetta di massimo 10 elementi su cui lo script farà lo spoglio per ambata e superiori.
Colpi di gioco e data di inizio analisi (solitamente uso dal concorso 8117 venus)

Grazie Mito

 

[salvo50]

Ciao a Tutti.

Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp,Salvo50,Casi,A,B,C
   Dim R,R1,R2,P,Po1,Po2,Po3,E,F1,F2,F3
   Dim Ru1(1),Ru2(1),aNum(10),Posta(5)
   Dim Pos(3),Fig(3)
   FIn = EstrazioneFin
   Ini = InputBox("INSERISCI L'ESTRAZIONE DI INIZIO",,8117)
   R = InputBox("INSERISCI LA RUOTA DI CALCOLO",,1)
   Po1 = CInt(InputBox("INSERISCI 1a POSIZIONE DEL 1° ESTRATTO",,1))
   F1 = CInt(InputBox("INSERISCI LA 1a FIGURA ",,2))
   Po2 = CInt(InputBox("INSERISCI 2a POSIZIONE DEL 2° ESTRATTO",,3))
   F2 = CInt(InputBox("INSERISCI LA 2a FIGURA ",,7))
   Po3 = CInt(InputBox("INSERISCI 3a POSIZIONE DEL 3° ESTRATTO",,4))
   F3 = CInt(InputBox("INSERISCI LA 3a FIGURA ",,2))
   R1 = InputBox("INSERISCI LA 1a RUOTA DI RICERCA LUNGHETTA",,5)
   R2 = InputBox("INSERISCI LA 2a RUOTA DI RICERCA LUNGHETTA",,12)
   If Po1 <> Po2 And Po1 <> Po3 And Po2 <> Po3 And R1 <> R2 Then
      Call ScegliNumeri(aNum)
      Clp = CInt(InputBox("VERIFICA ESITO IN COLPI? ",,13))
      'Call ScegliRange(Ini,FIn,Ini,FIn)
      Scrivi "PER SORUJOE - SCELTA RUOTA, 3 POSIZIONI E 3 FIGURE PER LUNGHETTA - SCRIPT SALVO50 ",1,,4,,3,,1
      Posta(1) = 1 : Posta(2) = 1 : Posta(3) = 1 : Posta(4) = 1 : Posta(5) = 1
      Ru1(1) = R1 : Ru2(1) = R2
      Pos(1) = Po1 : Pos(2) = Po2 : Pos(3) = Po3
      Fig(1) = F1 : Fig(2) = F2 : Fig(3) = F3
      For Es = Ini To FIn
         Messaggio Es
         AvanzamentoElab Ini,FIn,Es
         A = Estratto(Es,R,Po1)
         B = Estratto(Es,R,Po2)
         C = Estratto(Es,R,Po3)
         If Figura(A) = F1 And Figura(B) = F2 And Figura(C) = F3 Then
            Casi = Casi + 1
            Scrivi String(112,"*") & " Caso " & FormattaStringa(Casi,"0000"),1,,,1
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi " " & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E = Estratto(Es,R,P)
               If E = A Or E = B Or E = C Then
                  ColoreTesto 2
               Else
                  ColoreTesto 0
               End If
               Scrivi Format2(E) & " ",1,0
               ColoreTesto 0
            Next
            Scrivi
            Scrivi
            Scrivi " Ruota Scelta      " & NomeRuota(R),1,,,1
            Scrivi " Figure scelte     " & StringaNumeri(Fig," ",False),1,,,2
            Scrivi " Posizioni Scelte  " & StringaNumeri(Pos," ",False),1,,,1
            Scrivi
            Scrivi " Numeri Scelti Da Cercare ",1,0
            Scrivi StringaNumeri(aNum," ",True),1,,,2
            Scrivi
            Scrivi " Ruote Scelte Per Ricerca Numri Scelti     " & NomeRuota(R1) & " e " & NomeRuota(R2),1
            Scrivi
            ImpostaGiocata 1,aNum,Ru1,Posta,Clp
            ImpostaGiocata 2,aNum,Ru2,Posta,Clp
            Gioca Es,,,1
         End If
         If ScriptInterrotto Then Exit Sub
      Next
      ScriviResoconto
   Else
      If R1 = R2 Then Scrivi " ERRORE, HAI INSERITO PER LA RICERCA, 2 RUOTE UGUALI ",1,,4,2,6,,1
      If Po1 = Po2 Or Po1 = Po3 Or Po2 = Po3 Then Scrivi " ERRORE, HAI INSERITO 2 O PIU' POSIZIONI UGUALI ",1,,4,2,6,,1
   End If
End Sub

 

[sorujoe]

Grazie Salvo sei semplicemente UNICO