Modifica per Salvo50

sorujoe · 1 Giugno 2019

Si si è giusto li vedo pure io
se me lo implementi sulle somme distanze è ok in piu ti prego sull'ultimo script postato di togliermi il riscontro su tutte

salvo50 · 1 Giugno 2019

Tolto riscontro su tutte, proseguo con modifiche sugli script SOMME e DISTANZE

Codice:

Option Explicit
Sub Main
   Dim Fig1,Fig2,Fig3,Fig4,FIn,Ini,Clp
   Dim R1,R2,P1,P2,P3,P4,P5,P6,Es,Caso,Casi
   Dim E1,E2,A,B,C,D,FA,FB,FC,FD,Sp,Sorte
   Dim RetEsito,RetColpi,RetEstratti,RetId
   Dim Ruote(2),Ru(2),Post(5)
   ReDim aNum1(10),aNum2(10)
   'Post(1) = 1
   Post(2) = 1
   Post(3) = 1
   'Post(4) = 1
   'Post(5) = 1
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
   P1 = CInt(InputBox(" Indica la posizione del primo estratto della prima ruota",,1))
   Fig1 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della prima ruota",,1))
   '
   P2 = CInt(InputBox(" Indica la posizione del secondo estratto della prima ruota",,3))
   Fig2 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della prima ruota",,2))
   '
   P3 = CInt(InputBox(" Indica la posizione del primo estratto della seconda ruota",,4))
   Fig3 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della seconda ruota",,8))
   '
   P4 = CInt(InputBox(" Indica la posizione del secondo estratto della seconda ruota",,2))
   Fig4 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della seconda ruota",,7))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare? ",,5))
   'Sorte = CInt(InputBox(" Per qualè sorte? 1 per Ambata, 2 per Ambo, ecc... ",,3))
   Call ScegliNumeri(aNum1)
   Call ScegliNumeri(aNum2)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & " CHIESTO DA KUBES - SCELTA FIGURE E POSIZIONI ESTRATTI - SCRIPT SALVO50",1,,4,,3,,1
   For Es = Ini To FIn
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         A = Estratto(Es,R1,P1)
         B = Estratto(Es,R1,P2)
         FA = Figura(A) : FB = Figura(B)
         If Fig1 = FA And Fig2 = FB Then
            For R2 = R1 + 1 To 12
               C = Estratto(Es,R2,P3)
               D = Estratto(Es,R2,P4)
               FC = Figura(C) : FD = Figura(D)
               If Fig3 = FC And Fig4 = FD Then
                  Ru(1) = R1
                  Ru(2) = R2
                  'Ru(3) = TU_
                  Caso = Caso + 1
                  Casi = Casi + 1
                  Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                  Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                  Scrivi
                  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 Or E1 = B Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E1) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi " <--in Rosso Figure scelte " & FA & " " & FB,1
                  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 = C Or E2 = D Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E2) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi " <--in Rosso Figure scelte " & FC & " " & FD,1
                  Scrivi
                  Scrivi " Numeri scelti per 1ª Giocata " & StringaNumeri(aNum1,Sp,True),1,,,1
                  Scrivi " Numeri scelti per 2ª Giocata " & StringaNumeri(aNum2,Sp,True),1,,,2
                  Scrivi
                  ImpostaGiocata 1,aNum1,Ru,Post,Clp
                  ImpostaGiocata 2,aNum2,Ru,Post,Clp
                  Gioca Es,,,1
               End If
            Next
         End If
      Next
   Next
   ScriviResoconto
End Sub

sorujoe · 1 Giugno 2019

p e r f e t t t o
sei un mago

salvo50 · 1 Giugno 2019

Sono un mago con l'aiuto di Master

Questo è quello delle somme uguali, se va bene così, modifico anche quello delle distanze uguali

Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Salvo50,K,G
Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
Dim Somma,A,B,C,D,Sorte,S1,S2,Idestr
Dim RetEsito,RetColpi,RetEstratti,RetId
Dim Ruo(2)
ReDim aNum(20)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
Somma = CInt(InputBox("Inserisci la Somma comune da trovare",Salvo50,15))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
Call ScegliNumeri(aNum)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(6) & "PER BYRON 2 SOMME UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di MASTER",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
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
C = Estratto(Es,R2,P1)
D = Estratto(Es,R2,P2)
S1 = Fuori90(A + B) : S2 = Fuori90(C + D)
If(S1 = S2 And S1 = Somma) Then
Ruo(1) = R1
Ruo(2) = R2
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 P3 = 1 To 5
E1 = Estratto(Es,R1,P3)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S1,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P4 = 1 To 5
E2 = Estratto(Es,R2,P4)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S2,1
Scrivi
Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
Scrivi
K = 0
G = Es + Clp
If G > FIn Then G = FIn
For Idestr = Es + 1 To G
K = K + 1
Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
ColoreTesto 0
If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "° - " & Space(33) & " ESITO NON VERIFICATO ",1,,,1
If RetEsito <> "" Then
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Cinqina" Then ColoreTesto 3
Call Scrivi(Idestr & " - " & Format2(K) & "° - " & RetEstratti & " - " & RetEsito & " " & vbTab & GetInfoEstrazione(RetId),1)
ColoreTesto 0
End If
Next
Scrivi
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub

sorujoe · 1 Giugno 2019

Perfetto puoi andare

GRAZIE

salvo50 · 1 Giugno 2019

Distanze uguali

Codice:

Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp,Salvo50,K,G
   Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
   Dim Dist,A,B,C,D,Sorte,D1,D2,Idestr
   Dim RetEsito,RetColpi,RetEstratti,RetId
   Dim Ruo(2)
   ReDim aNum(20)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
   Dist = CInt(InputBox("Inserisci la Distanza Ciclometrica da trovare",Salvo50,15))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
   Call ScegliNumeri(aNum)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi "PER BYRON 2 DISTANZE CICLOMETRICHE UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di Master",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
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  D1 = Distanza(A,B) : D2 = Distanza(C,D)
                  If(D1 = D2 And D1 = Dist) Then
                     Ruo(1) = R1
                     Ruo(2) = R2
                     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 P3 = 1 To 5
                        E1 = Estratto(Es,R1,P3)
                        If E1 = A Or E1 = B Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi "  <-- Rossi Distanza " & D1,1
                     Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi " " & SiglaRuota(R2) & " ",1,0
                     For P4 = 1 To 5
                        E2 = Estratto(Es,R2,P4)
                        If E2 = C Or E2 = D Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E2) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi "  <-- Rossi Distanza " & D2,1
                     Scrivi
                     Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
                     Scrivi
                     K = 0 : G = 0
                     G = Es + Clp
                     If G > FIn Then G = FIn
                     For Idestr = Es + 1 To G
                        K = K + 1
                        Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
                        ColoreTesto 0
                        If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "°  - " & Space(30) & " ESITO NON VERIFICATO ",1,,,1
                        If RetEsito <> "" Then
                           If RetEsito = "Ambo" Then ColoreTesto 2
                           If RetEsito = "Terno" Then ColoreTesto 1
                           If RetEsito = "Quaterna" Then ColoreTesto 7
                           If RetEsito = "Cinqina" Then ColoreTesto 3
                           Call Scrivi(Idestr & " - " & Format2(K) & "°  - " & RetEstratti & " - " & RetEsito & "  " & vbTab & GetInfoEstrazione(RetId),1)
                           ColoreTesto 0
                        End If
                     Next
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub

sorujoe · 1 Giugno 2019

Non volgio solo un grazie ti prego contattami in privato è giusto una ricompensa

salvo50 · 2 Giugno 2019

BYRON;n2174245 ha scritto:
Non volgio solo un grazie ti prego contattami in privato è giusto una ricompensa

Neanche per sogno, un grazie va benissimo

sorujoe · 2 Giugno 2019

Ti meriti altro che un grazie che ti scrivo volentieri G R A Z I E

Cerca

Cerca

Modifica per Salvo50

sorujoe

Advanced Member >GOLD<

salvo50

Advanced Member >PLATINUM PLUS<

sorujoe

Advanced Member >GOLD<

salvo50

Advanced Member >PLATINUM PLUS<

sorujoe

Advanced Member >GOLD<

salvo50

Advanced Member >PLATINUM PLUS<

sorujoe

Advanced Member >GOLD<

salvo50

Advanced Member >PLATINUM PLUS<

sorujoe

Advanced Member >GOLD<

Ultima estrazione Lotto

Ultimi Messaggi