Per Salvo 50

[Raimbow58]

Ciao Salvo 50, intanto grazie per gli altri script che hai fatto. Volevo chiederti quando hai tempo se possibile fare uno script che trova su ruote diametrali due numeri distanza 5 appartenenti alla stessa decina e, una volta trovati fare il più 45 di tutti e due e aggiungere i diametrali in decina. Metto un esempio, estrazione del 31/10/2019:
BARI 15 39 75 78 20
NAPOLI 8 34 25 83 59
Previsione: BA NA 84 89 79 74
39+45=84 diam dec 89
34+45=79 diam dec 74
Spero di aver spiegato bene.
Grazie

 

[salvo50]

Ciao a Tutti.

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,Clp,Es,Salvo50
   Dim R1,R2,P1,P5,P6,E1,E2,Caso,Casi
   Dim Diam_A,Diam_B,DiamD_DiamA,DiamD_DiamB
   Dim Ruo(2),Po1(4),Qua(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9400))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,10))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(1) & " Ruote Diametrali, 2 Estratti Distanza 5, Stessa Decina, Isotopi - SCRIPT SALVO50",1,,4,,3,,1
   Po1(2) = 1
   'Po1(3) = 1
   'Po1(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            For R2 = R1 + 1 To 10
               If R2 = RuotaDiametrale(R1) Then
                  B = Estratto(Es,R2,P1)
                  If A > 0 And B > 0 Then
                     If(Decina(A) = Decina(B))And B = DiametraleD(A) Then
                        Diam_A = Diametrale(A)
                        Diam_B = Diametrale(B)
                        DiamD_DiamA = DiametraleD(Diam_A)
                        DiamD_DiamB = DiametraleD(Diam_B)
                        Qua(1) = Diam_A
                        Qua(2) = Diam_B
                        Qua(3) = DiamD_DiamA
                        Qua(4) = DiamD_DiamB
                        Caso = Caso + 1
                        Casi = Casi + 1
                        Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
                        Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
                        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 = A 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 P6 = 1 To 5
                           E2 = Estratto(Es,R2,P6)
                           If E2 = B Then
                              ColoreTesto 2
                           Else
                              ColoreTesto 0
                           End If
                           Scrivi Format2(E2) & " ",1,0
                           ColoreTesto 0
                        Next
                        Scrivi
                        Scrivi " Diametrale        di " & Format2(A) & " = " & Format2(Diam_A),1
                        Scrivi " Diametrale        di " & Format2(B) & " = " & Format2(Diam_B),1
                        Scrivi " Diametrale Decina di " & Format2(Diam_A) & " = " & Format2(DiamD_DiamA),1
                        Scrivi " Diametrale Decina di " & Format2(Diam_B) & " = " & Format2(DiamD_DiamB),1
                        Scrivi
                        Ruo(1) = R1 : Ruo(2) = R2
                        ImpostaGiocata 1,Qua,Ruo,Po1,Clp
                        Gioca Es
                        
                     End If
                  End If
               End If
            Next
            
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub

 

[Raimbow58]

Grazie Salvo 50, funziona perfettamente. E' possibile aggiungere il controllo su tutte?

 

[salvo50]

Con controllo su tutte

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,Clp,Es,Salvo50
   Dim R1,R2,P1,P5,P6,E1,E2,Caso,Casi
   Dim Diam_A,Diam_B,DiamD_DiamA,DiamD_DiamB
   Dim Ru(1),Ruo(3),Po1(4),Po2(4),Qua(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9400))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,10))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(1) & " Ruote Diametrali, 2 Estratti Distanza 5, Stessa Decina, Isotopi - SCRIPT SALVO50",1,,4,,3,,1
   Po1(2) = 1
   'Po1(3) = 1
   'Po1(4) = 1
   Po2(2) = 1
   Po2(3) = 1
   Po2(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            For R2 = R1 + 1 To 10
               If R2 = RuotaDiametrale(R1) Then
                  B = Estratto(Es,R2,P1)
                  If A > 0 And B > 0 Then
                     If(Decina(A) = Decina(B))And B = DiametraleD(A) Then
                        Diam_A = Diametrale(A)
                        Diam_B = Diametrale(B)
                        DiamD_DiamA = DiametraleD(Diam_A)
                        DiamD_DiamB = DiametraleD(Diam_B)
                        Qua(1) = Diam_A
                        Qua(2) = Diam_B
                        Qua(3) = DiamD_DiamA
                        Qua(4) = DiamD_DiamB
                        Caso = Caso + 1
                        Casi = Casi + 1
                        Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
                        Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
                        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 = A 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 P6 = 1 To 5
                           E2 = Estratto(Es,R2,P6)
                           If E2 = B Then
                              ColoreTesto 2
                           Else
                              ColoreTesto 0
                           End If
                           Scrivi Format2(E2) & " ",1,0
                           ColoreTesto 0
                        Next
                        Scrivi
                        Scrivi " Diametrale        di " & Format2(A) & " = " & Format2(Diam_A),1
                        Scrivi " Diametrale        di " & Format2(B) & " = " & Format2(Diam_B),1
                        Scrivi " Diametrale Decina di " & Format2(Diam_A) & " = " & Format2(DiamD_DiamA),1
                        Scrivi " Diametrale Decina di " & Format2(Diam_B) & " = " & Format2(DiamD_DiamB),1
                        Scrivi
                        Ru(1) = TU_
                        Ruo(1) = R1 : Ruo(2) = R2
                        ImpostaGiocata 1,Qua,Ruo,Po1,Clp
                        ImpostaGiocata 2,Qua,Ru,Po2,Clp
                        Gioca Es
                     End If
                  End If
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub