Novità

terno metodo camaleonte

Alberto Anderlini

Super member
Mi riferivo solo alla conferma dell'esattezza dei calcoli, quella effettivamente non c' mai stata, infatti come scritto i stesso mi accorgevo dei problemi degli script. Comunque non era una polemica ma per quietare i legend che tra gli scripter è sul serio una leggenda. Se ti ho offeso chiedo scusa.
no assolutamente, i calcoli andavano bene era le modifiche che poi sono state fatte.
già che siamo in linea, come posso utilizzare uno script che non ho senza usare spaziometria? lo script sarebbe la ricerca di ambi o terni su un archivio fatto in excel in orizzontale.
se già c'è mi dici chi la messo? grazie
 

vengio

Super Member >GOLD<
Non capisco cio che vuoi dire, magari apri un post di aiuto in area dawnloads. Vedrai che qualcuno ti darà una mano. O almeno inserisci qui ciò che hai per farmi capire. Ciao.
 

i legend

Premium Member
Ciao a tutti
allo script , se non ho fatto errori , ho aggiunto la voce copertura casi , le estrazioni giocate ,se la previsione è ancora in gioco oppure ha raggiunto i colpi.
allego immagine e script.
spiegazione Output.png
allego script da verificare
quindi sempre Salvo errori ed omissis
Codice:
Option Explicit
' Controllare se lo script Fa quanto richiesto
' controllare se i dati riportati sono corretti
' Salvo errori ed omissis
Sub Main
   Dim aRuSpia,nRuSpia
   nRuSpia = Specchietto(aRuSpia)
   If nRuSpia = False Then
      Call MsgBox("Hai inserito una o piu ruote non valide",4,"Errore Ruota")
      Exit Sub
   End If
   Dim Ini,Fin
   Call ScegliRange(Ini,Fin,3950,EstrazioneFin)
   If Not isIdEstrValido(Ini) Then Call MsgBox("Range estrazioni non valido",vbError,"Messaggio di errore"): Exit Sub
   Dim nClp:nClp = CInt(InputBox("Scegli numero compreso tra 1 e 30","Seleziona Colpi di gioco",18))
   Dim IniG,FinG
   Dim IdEstr,R,p,pp,ps
   Dim E1p,E1,Eps,Es,v1,v2
   Dim nCasiTro,nCasiSin,nCasiDes
   Dim aAmbD,aAmbS,aTern1S,aTern2S,aTern1D,aTern2D
   Dim aRuVer(1),aRt(1)
   Dim FrzAsinRuota,FrezAsinTutte,FrzAsinRuotaTotale,FrezAsinTutteTotale
   Dim FrzADesRuota,FrzAdesTutte,FrzADesRuotaTotale,FrzAdesTutteTotale
   Dim FrzTern1SinRuota,FrzTern1SinTutte,FrzTern1SinRuotaTotale,FrzTern1SinTutteTotale
   Dim FrzTern2SinRuota,FrzTern2SinTutte,FrzTern2SinRuotaTotale,FrzTern2SinTutteTotale
   Dim FrzTern1DesRuota,FrzTern1DesTutte,FrzTern1DesRuotaTotale,FrzTern1DesTutteTotale
   Dim FrzTern2DesRuota,FrzTern2DesTutte,FrzTern2DesRuotaTotale,FrzTern2DesTutteTotale
   Dim PresFormAmboS_Ru,PresFormAmboD_Ru,PresFormAmboS_TT,PresFormAmboD_TT
   Dim PresFormTerS_Ru,PresFormTerD_Ru,PresFormTerS_TT,PresFormTerD_TT
   Dim sSep:sSep = "  |  "
   Dim LineaStitSup:LineaStitSup = " |_________ ________________ ____________________________|__________________ ______ _____________ ____________ ___________ "
   Dim LineaStitSup1:LineaStitSup1 = " |         |                |                            |                  |      |             |            |    Ambo   |"
   Dim sTit:sTit = " |   nCaso |  Ruota         |   Info Estrazione          |    Estrazione    | nRpt |  Laterali   | Formazioni |RSpia|Tutte|"
   Dim LineasTit:LineasTit = " |_________|________________|____________________________|__________________|______|_____________|____________|_____|_____|"
   aRt(1) = 11
   nCasiTro = 0
   nCasiSin = 0
   nCasiDes = 0
   Call SetColorSezione(RGB(0,0,0))
   For IdEstr = Ini To Fin
      For R = 1 To UBound(aRuSpia)
         aRuVer(1) = aRuSpia(R)
         If Estratto(IdEstr - 1,aRuVer(1),1) Then
            For p = 1 To 5
               E1p = Estratto(IdEstr - 1,aRuVer(1),p)
               E1 = Estratto(IdEstr,aRuVer(1),p)
               If E1p = E1 Then
                  IniG = IdEstr + 1
                  FinG = IniG + nClp
                  If FinG>Fin Then FinG=Fin
                  Dim ClpG :ClpG = Fin - IdEstr
                  If ClpG > nClp Then
                     Scrivi "   _____________________________________________________",,,,vbRed
                     Scrivi " |-",,0,,vbCyan
                     Scrivi FormatSpace("   Verifica Metodo Terminata",53),,0,vbRed
                     Scrivi "-|",,,,vbCyan

                  Else
                     Scrivi "   _____________________________________________________",,,,vbGreen
                     Scrivi " |-",,0,,vbCyan
                     Scrivi FormatSpace("   Metodo In corso [estrazioni verificate : "&ClpG & "]",53),,0,vbGreen
                     Scrivi "-|",,,,vbCyan
                  End If
                  Scrivi LineaStitSup,,,,vbCyan
                  Scrivi LineaStitSup1,,,,vbCyan
                  Scrivi sTit,,,,vbCyan
                  Scrivi LineasTit,,,,vbCyan
                  nCasiTro = nCasiTro + 1
                  pp = FuoriX(p - 1,5) ' estratto a sinistra
                  ps = FuoriX(p + 1,5) ' estratto a destra
                  ' prendo gli estratti a sinistra
                  Eps = Estratto(IdEstr - 1,aRuVer(1),pp) ' estratto a sinistra estrazione precedente
                  Es = Estratto(IdEstr,aRuVer(1),pp) ' estratto asinistra estrazionein corso
                  v1 = pari(Eps)
                  v2 = pari(Es)
                  If v1 = v2 Then
                     nCasiSin = nCasiSin + 1
                     Call Calcola(E1p,E1,Eps,Es,aAmbS,aTern1S,aTern2S)
                     ' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
                     FrzAsinRuota = SerieFreqTurbo(IniG,FinG,aAmbS,aRuVer,2)
                     'calcolo la frequenza totale dell ambo a sinistra su ruota
                     FrzAsinRuotaTotale = FrzAsinRuotaTotale + FrzAsinRuota
                     ' calcolo la frequenza dell ambo a sinistra su tutte
                     FrezAsinTutte = SerieFreqTurbo(IniG,FinG,aAmbS,aRt,2)
                     ' calcolo la frequenza  totale dell ambo a sinistra su tutte
                     FrezAsinTutteTotale = FrezAsinTutteTotale + FrezAsinTutte
                     If FrzAsinRuota Then PresFormAmboS_Ru = PresFormAmboS_Ru + 1
                     If FrezAsinTutte Then PresFormAmboS_TT = PresFormAmboS_TT + 1
                     ' Terzina 1
                     ' -------------------------------------------------------------------
                     ' calcolo la frequenza della prima terzina a sinistra a ruota
                     FrzTern1SinRuota = SerieFreqTurbo(IniG,FinG,aTern1S,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern1SinRuotaTotale = FrzTern1SinRuotaTotale + FrzTern1SinRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern1SinTutte = SerieFreqTurbo(IniG,FinG,aTern1S,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern1SinTutteTotale = FrzTern1SinTutteTotale + FrzTern1SinTutte
                     ' Terzina 2
                     ' --------------------------------------------------------------------
                     ' calcolo la frequenza della seconda terzina a sinistra a ruota
                     FrzTern2SinRuota = SerieFreqTurbo(IniG,FinG,aTern2S,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern2SinRuotaTotale = FrzTern2SinRuotaTotale + FrzTern2SinRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern2SinTutte = SerieFreqTurbo(IniG,FinG,aTern2S,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern2SinTutteTotale = FrzTern2SinTutteTotale + FrzTern2SinTutte
                     ' calcolo la presenza di una delle due terzine
                     If FrzTern1SinRuota Or FrzTern2SinRuota Then PresFormTerS_Ru = PresFormTerS_Ru + 1
                     If FrzTern1SinTutte Or FrzTern2SinTutte Then PresFormTerS_TT = PresFormTerS_TT + 1
                     '
                     Rem comincio a preparare l output
                     ' Rigo 1
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
                     FormatSpace("",2) & sSep & FormatSpace("",9) & sSep & FormatSpace(StringaNumeri(aAmbS,,True),8) & sSep & _
                     FrzAsinRuota & sSep & FrezAsinTutte & sSep,,,,vbCyan
                     ' rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern1S,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1SinRuota,,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1SinTutte,,0,,vbCyan
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern2S,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern2SinRuota,,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern2SinTutte,,0,,vbCyan
                     Scrivi sSep,,,,vbCyan
                  Else
                     Rem Rigo 1
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
                     FormatSpace("",2) & sSep & FormatSpace("",9) & sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     '
                  End If ' qui controllo se entrambi gli estratti sono pari o dispari
                  Eps = Estratto(IdEstr - 1,aRuVer(1),ps) ' estratto a Destra estrazione precedente
                  Es = Estratto(IdEstr,aRuVer(1),ps) ' estratto a Destra estrazionein corso
                  v1 = pari(Eps)
                  v2 = pari(Es)
                  If v1 = v2 Then
                     nCasiDes = nCasiDes + 1
                     Call Calcola(E1p,E1,Eps,Es,aAmbD,aTern1D,aTern2D)
                     ' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
                     FrzADesRuota = SerieFreqTurbo(IniG,FinG,aAmbD,aRuVer,2)
                     'calcolo la frequenza totale dell ambo a sinistra su ruota
                     FrzADesRuotaTotale = FrzADesRuotaTotale + FrzADesRuota
                     ' calcolo la frequenza dell ambo a sinistra su tutte
                     FrzAdesTutte = SerieFreqTurbo(IniG,FinG,aAmbD,aRt,2)
                     ' calcolo la frequenza  totale dell ambo a sinistra su tutte
                     FrzAdesTutteTotale = FrzAdesTutteTotale + FrzAdesTutte
                     ' Terzina 1
                     ' -------------------------------------------------------------------
                     ' calcolo la frequenza della prima terzina a sinistra a ruota
                     FrzTern1DesRuota = SerieFreqTurbo(IniG,FinG,aTern1D,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern1DesRuotaTotale = FrzTern1DesRuotaTotale + FrzTern1DesRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern1DesTutte = SerieFreqTurbo(IniG,FinG,aTern1D,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern1DesTutteTotale = FrzTern1DesTutteTotale + FrzTern1DesTutte
                     ' Terzina 2
                     ' --------------------------------------------------------------------
                     ' calcolo la frequenza della seconda terzina a sinistra a ruota
                     FrzTern2DesRuota = SerieFreqTurbo(IniG,FinG,aTern2D,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern2DesRuotaTotale = FrzTern2DesRuotaTotale + FrzTern2DesRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern2DesTutte = SerieFreqTurbo(IniG,FinG,aTern2D,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern2DesTutteTotale = FrzTern2DesTutteTotale + FrzTern2DesTutte
                     '
                     'faccio i calcoli delle presenze e copertura casi
                     If FrzADesRuota Then PresFormAmboD_Ru = PresFormAmboD_Ru + 1
                     If FrzAdesTutte Then PresFormAmboD_TT = PresFormAmboD_TT + 1
                     If FrzTern1DesRuota Or FrzTern2DesRuota Then PresFormTerD_Ru = PresFormTerD_Ru + 1
                     If FrzTern1DesTutte Or FrzTern2DesTutte Then PresFormTerD_TT = PresFormTerD_TT + 1
                     Rem comincio a preparare l output
                     ' Rigo 1
                     Scrivi " |   " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
                     FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aAmbD,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzADesRuota & sSep & FrzAdesTutte & sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Es,2) & " ) ",,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern1D,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1DesRuota & sSep & FrzTern1DesTutte & sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
                     Space(9) & sSep & FormatSpace(StringaNumeri(aTern2D,,True),8) & sSep & _
                     FrzTern2DesRuota & sSep & FrzTern2DesTutte & sSep,,,,vbCyan
                     Rem rigo 4
                     Scrivi LineasTit,,,,vbCyan
                  Else
                     Scrivi " |   " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
                     FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
                     Space(9) & sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 4
                     Scrivi LineasTit,,,,vbCyan
                  End If ' controllo se sono entrambi pari o dispari
                  Scrivi
               End If ' Verifico che esistano gli estratti isotopi
               If ScriptInterrotto Then Exit For
            Next ' p
            If ScriptInterrotto Then Exit For
         End If ' verifico se l estrazione esiste
      Next ' R
      If ScriptInterrotto Then Exit For
      Call AvanzamentoElab(Ini,Fin,IdEstr)
   Next ' idestr
   Scrivi : Scrivi
   Scrivi "  Info su : https://forum.lottoced.com/threads/terno-metodo-camaleonte.2191331/",1,,,RGB(255,128,0)
   Scrivi "  Info su : https://forum.lottoced.com/threads/camaleonte-in-terno-secco.96329/",1,,,RGB(255,128,0)
   Scrivi
   Scrivi " ",,0
   Scrivi FormatSpace(" ",82),,,vbCyan
   Scrivi " ",,0
   Scrivi FormatSpace("  RESOCONTO SU :                          |   " & StringaRuote(aRuSpia),80) & "  ",,,vbCyan
   Scrivi
   Scrivi "  Range Concorsi analizzati:               |  " & Ini & " - " & Fin,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Estrazioni di verifica Metodo Aldini:    |  " & nClp ,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero Casi Totali:                      |  " & nCasiTro,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero casi Giocabili a sinistra:        |  " & nCasiSin,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Ambi a Ruota a Sinistra:                 |  " & FrzAsinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi a Tutte a Sinistra:                 |  " & FrezAsinTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Ruota:              |  " & PresFormAmboS_Ru,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Tutte:              |  " & PresFormAmboS_TT,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Ruota a Sinistra:    |  " & FrzTern1SinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Tutte a Sinistra:    |  " & FrzTern1SinTutteTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Ruota a Sinistra:    |  " & FrzTern2SinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Tutte a Sinistra:    |  " & FrzTern2SinTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Ruota: |  " & PresFormTerS_Ru,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Tutte: |  " & PresFormTerS_TT,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero casi Giocabili a Destra:          |  " & nCasiDes,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Ambi a Ruota a Destra:                   |  " & FrzADesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi a Tutte a Destra:                   |  " & FrzAdesTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Ruota:              |  " & PresFormAmboD_Ru,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Tutte:              |  " & PresFormAmboD_TT,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Ruota a Destra:      |  " & FrzTern1DesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Tutte a Destra:      |  " & FrzTern1DesTutteTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Ruota a Destra:      |  " & FrzTern2DesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Tutte a Destra:      |  " & FrzTern2DesTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Ruota: |  " & PresFormTerD_Ru,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Tutte: |  " & PresFormTerD_TT,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
End Sub
Function Specchietto(aV)
   Dim R,s,s1,IdEstr,bRet,p,idR
   s = ""
   For R = 1 To 12
      If R = 11 Then R = 12
      s = s & Format2(R) & " )  " & SiglaRuota(R) & "... "
      s1 = ""
      For IdEstr = EstrazioneFin To EstrazioneFin - 9 Step - 1
         bRet = False
         For p = 1 To 5
            If Estratto(IdEstr,R,p) = Estratto(IdEstr - 1,R,p) Then bRet = True :Exit For
         Next 'p
         If bRet Then s1 = s1 & " x ":Else s1 = s1 & " 0 "
      Next 'idestr
      s = s & s1 & vbCrLf
   Next 'R
   idR = InputBox(s,"Seleziona Numero/i Ruota di Ricerca,separati da punto","1.2.3.4.5.6.7.8.9.10.12")
   If idR = "" Then Specchietto = False :Exit Function
   aV = Split("0." & idR,".")
   For p = 1 To UBound(aV)
      If isRuotaValidaLotto(aV(p)) And aV(p) <> 11 Then
         Specchietto = True
      Else
         Specchietto = False
         Exit For
      End If
   Next
End Function
Sub Calcola(E1p,E1S,E0p,E0s,aAmb,aTern1,aTern2)
   Dim op1:op1 = E1p + E1S
   Dim op2:op2 = Differenza(E0p,E0s)
   Dim op3:op3 = Fuori90((op1 + op2)/2)
   Dim op4:op4 = Fuori90(Differenza(op1,op3))
   Dim op5:op5 = Fuori90(op1 + 1)
   Dim op6:op6 = Fuori90(op1 + 2)
   aAmb = Array(0,op3,op4)
   aTern1 = Array(0,op3,op4,op5)
   aTern2 = Array(0,op3,op4,op6)
End Sub
X Vengio
grazie mille troppo gentile :)
 

Alberto Anderlini

Super member
Ciao a tutti
allo script , se non ho fatto errori , ho aggiunto la voce copertura casi , le estrazioni giocate ,se la previsione è ancora in gioco oppure ha raggiunto i colpi.
allego immagine e script.
Vedi l'allegato 2192006
allego script da verificare
quindi sempre Salvo errori ed omissis
Codice:
Option Explicit
' Controllare se lo script Fa quanto richiesto
' controllare se i dati riportati sono corretti
' Salvo errori ed omissis
Sub Main
   Dim aRuSpia,nRuSpia
   nRuSpia = Specchietto(aRuSpia)
   If nRuSpia = False Then
      Call MsgBox("Hai inserito una o piu ruote non valide",4,"Errore Ruota")
      Exit Sub
   End If
   Dim Ini,Fin
   Call ScegliRange(Ini,Fin,3950,EstrazioneFin)
   If Not isIdEstrValido(Ini) Then Call MsgBox("Range estrazioni non valido",vbError,"Messaggio di errore"): Exit Sub
   Dim nClp:nClp = CInt(InputBox("Scegli numero compreso tra 1 e 30","Seleziona Colpi di gioco",18))
   Dim IniG,FinG
   Dim IdEstr,R,p,pp,ps
   Dim E1p,E1,Eps,Es,v1,v2
   Dim nCasiTro,nCasiSin,nCasiDes
   Dim aAmbD,aAmbS,aTern1S,aTern2S,aTern1D,aTern2D
   Dim aRuVer(1),aRt(1)
   Dim FrzAsinRuota,FrezAsinTutte,FrzAsinRuotaTotale,FrezAsinTutteTotale
   Dim FrzADesRuota,FrzAdesTutte,FrzADesRuotaTotale,FrzAdesTutteTotale
   Dim FrzTern1SinRuota,FrzTern1SinTutte,FrzTern1SinRuotaTotale,FrzTern1SinTutteTotale
   Dim FrzTern2SinRuota,FrzTern2SinTutte,FrzTern2SinRuotaTotale,FrzTern2SinTutteTotale
   Dim FrzTern1DesRuota,FrzTern1DesTutte,FrzTern1DesRuotaTotale,FrzTern1DesTutteTotale
   Dim FrzTern2DesRuota,FrzTern2DesTutte,FrzTern2DesRuotaTotale,FrzTern2DesTutteTotale
   Dim PresFormAmboS_Ru,PresFormAmboD_Ru,PresFormAmboS_TT,PresFormAmboD_TT
   Dim PresFormTerS_Ru,PresFormTerD_Ru,PresFormTerS_TT,PresFormTerD_TT
   Dim sSep:sSep = "  |  "
   Dim LineaStitSup:LineaStitSup = " |_________ ________________ ____________________________|__________________ ______ _____________ ____________ ___________ "
   Dim LineaStitSup1:LineaStitSup1 = " |         |                |                            |                  |      |             |            |    Ambo   |"
   Dim sTit:sTit = " |   nCaso |  Ruota         |   Info Estrazione          |    Estrazione    | nRpt |  Laterali   | Formazioni |RSpia|Tutte|"
   Dim LineasTit:LineasTit = " |_________|________________|____________________________|__________________|______|_____________|____________|_____|_____|"
   aRt(1) = 11
   nCasiTro = 0
   nCasiSin = 0
   nCasiDes = 0
   Call SetColorSezione(RGB(0,0,0))
   For IdEstr = Ini To Fin
      For R = 1 To UBound(aRuSpia)
         aRuVer(1) = aRuSpia(R)
         If Estratto(IdEstr - 1,aRuVer(1),1) Then
            For p = 1 To 5
               E1p = Estratto(IdEstr - 1,aRuVer(1),p)
               E1 = Estratto(IdEstr,aRuVer(1),p)
               If E1p = E1 Then
                  IniG = IdEstr + 1
                  FinG = IniG + nClp
                  If FinG>Fin Then FinG=Fin
                  Dim ClpG :ClpG = Fin - IdEstr
                  If ClpG > nClp Then
                     Scrivi "   _____________________________________________________",,,,vbRed
                     Scrivi " |-",,0,,vbCyan
                     Scrivi FormatSpace("   Verifica Metodo Terminata",53),,0,vbRed
                     Scrivi "-|",,,,vbCyan

                  Else
                     Scrivi "   _____________________________________________________",,,,vbGreen
                     Scrivi " |-",,0,,vbCyan
                     Scrivi FormatSpace("   Metodo In corso [estrazioni verificate : "&ClpG & "]",53),,0,vbGreen
                     Scrivi "-|",,,,vbCyan
                  End If
                  Scrivi LineaStitSup,,,,vbCyan
                  Scrivi LineaStitSup1,,,,vbCyan
                  Scrivi sTit,,,,vbCyan
                  Scrivi LineasTit,,,,vbCyan
                  nCasiTro = nCasiTro + 1
                  pp = FuoriX(p - 1,5) ' estratto a sinistra
                  ps = FuoriX(p + 1,5) ' estratto a destra
                  ' prendo gli estratti a sinistra
                  Eps = Estratto(IdEstr - 1,aRuVer(1),pp) ' estratto a sinistra estrazione precedente
                  Es = Estratto(IdEstr,aRuVer(1),pp) ' estratto asinistra estrazionein corso
                  v1 = pari(Eps)
                  v2 = pari(Es)
                  If v1 = v2 Then
                     nCasiSin = nCasiSin + 1
                     Call Calcola(E1p,E1,Eps,Es,aAmbS,aTern1S,aTern2S)
                     ' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
                     FrzAsinRuota = SerieFreqTurbo(IniG,FinG,aAmbS,aRuVer,2)
                     'calcolo la frequenza totale dell ambo a sinistra su ruota
                     FrzAsinRuotaTotale = FrzAsinRuotaTotale + FrzAsinRuota
                     ' calcolo la frequenza dell ambo a sinistra su tutte
                     FrezAsinTutte = SerieFreqTurbo(IniG,FinG,aAmbS,aRt,2)
                     ' calcolo la frequenza  totale dell ambo a sinistra su tutte
                     FrezAsinTutteTotale = FrezAsinTutteTotale + FrezAsinTutte
                     If FrzAsinRuota Then PresFormAmboS_Ru = PresFormAmboS_Ru + 1
                     If FrezAsinTutte Then PresFormAmboS_TT = PresFormAmboS_TT + 1
                     ' Terzina 1
                     ' -------------------------------------------------------------------
                     ' calcolo la frequenza della prima terzina a sinistra a ruota
                     FrzTern1SinRuota = SerieFreqTurbo(IniG,FinG,aTern1S,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern1SinRuotaTotale = FrzTern1SinRuotaTotale + FrzTern1SinRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern1SinTutte = SerieFreqTurbo(IniG,FinG,aTern1S,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern1SinTutteTotale = FrzTern1SinTutteTotale + FrzTern1SinTutte
                     ' Terzina 2
                     ' --------------------------------------------------------------------
                     ' calcolo la frequenza della seconda terzina a sinistra a ruota
                     FrzTern2SinRuota = SerieFreqTurbo(IniG,FinG,aTern2S,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern2SinRuotaTotale = FrzTern2SinRuotaTotale + FrzTern2SinRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern2SinTutte = SerieFreqTurbo(IniG,FinG,aTern2S,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern2SinTutteTotale = FrzTern2SinTutteTotale + FrzTern2SinTutte
                     ' calcolo la presenza di una delle due terzine
                     If FrzTern1SinRuota Or FrzTern2SinRuota Then PresFormTerS_Ru = PresFormTerS_Ru + 1
                     If FrzTern1SinTutte Or FrzTern2SinTutte Then PresFormTerS_TT = PresFormTerS_TT + 1
                     '
                     Rem comincio a preparare l output
                     ' Rigo 1
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
                     FormatSpace("",2) & sSep & FormatSpace("",9) & sSep & FormatSpace(StringaNumeri(aAmbS,,True),8) & sSep & _
                     FrzAsinRuota & sSep & FrezAsinTutte & sSep,,,,vbCyan
                     ' rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern1S,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1SinRuota,,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1SinTutte,,0,,vbCyan
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern2S,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern2SinRuota,,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern2SinTutte,,0,,vbCyan
                     Scrivi sSep,,,,vbCyan
                  Else
                     Rem Rigo 1
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
                     FormatSpace("",2) & sSep & FormatSpace("",9) & sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
                     Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     '
                  End If ' qui controllo se entrambi gli estratti sono pari o dispari
                  Eps = Estratto(IdEstr - 1,aRuVer(1),ps) ' estratto a Destra estrazione precedente
                  Es = Estratto(IdEstr,aRuVer(1),ps) ' estratto a Destra estrazionein corso
                  v1 = pari(Eps)
                  v2 = pari(Es)
                  If v1 = v2 Then
                     nCasiDes = nCasiDes + 1
                     Call Calcola(E1p,E1,Eps,Es,aAmbD,aTern1D,aTern2D)
                     ' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
                     FrzADesRuota = SerieFreqTurbo(IniG,FinG,aAmbD,aRuVer,2)
                     'calcolo la frequenza totale dell ambo a sinistra su ruota
                     FrzADesRuotaTotale = FrzADesRuotaTotale + FrzADesRuota
                     ' calcolo la frequenza dell ambo a sinistra su tutte
                     FrzAdesTutte = SerieFreqTurbo(IniG,FinG,aAmbD,aRt,2)
                     ' calcolo la frequenza  totale dell ambo a sinistra su tutte
                     FrzAdesTutteTotale = FrzAdesTutteTotale + FrzAdesTutte
                     ' Terzina 1
                     ' -------------------------------------------------------------------
                     ' calcolo la frequenza della prima terzina a sinistra a ruota
                     FrzTern1DesRuota = SerieFreqTurbo(IniG,FinG,aTern1D,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern1DesRuotaTotale = FrzTern1DesRuotaTotale + FrzTern1DesRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern1DesTutte = SerieFreqTurbo(IniG,FinG,aTern1D,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern1DesTutteTotale = FrzTern1DesTutteTotale + FrzTern1DesTutte
                     ' Terzina 2
                     ' --------------------------------------------------------------------
                     ' calcolo la frequenza della seconda terzina a sinistra a ruota
                     FrzTern2DesRuota = SerieFreqTurbo(IniG,FinG,aTern2D,aRuVer,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a ruota
                     FrzTern2DesRuotaTotale = FrzTern2DesRuotaTotale + FrzTern2DesRuota
                     ' Calcolo la frequenza della prima terzina a sinistra a tutte
                     FrzTern2DesTutte = SerieFreqTurbo(IniG,FinG,aTern2D,aRt,2)
                     'calcolo la frequenza totale della prima terzina a sinistra a tutte
                     FrzTern2DesTutteTotale = FrzTern2DesTutteTotale + FrzTern2DesTutte
                     '
                     'faccio i calcoli delle presenze e copertura casi
                     If FrzADesRuota Then PresFormAmboD_Ru = PresFormAmboD_Ru + 1
                     If FrzAdesTutte Then PresFormAmboD_TT = PresFormAmboD_TT + 1
                     If FrzTern1DesRuota Or FrzTern2DesRuota Then PresFormTerD_Ru = PresFormTerD_Ru + 1
                     If FrzTern1DesTutte Or FrzTern2DesTutte Then PresFormTerD_TT = PresFormTerD_TT + 1
                     Rem comincio a preparare l output
                     ' Rigo 1
                     Scrivi " |   " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
                     FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aAmbD,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzADesRuota & sSep & FrzAdesTutte & sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Es,2) & " ) ",,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FormatSpace(StringaNumeri(aTern1D,,True),8),,0,,vbCyan
                     Scrivi sSep,,0,,vbCyan
                     Scrivi FrzTern1DesRuota & sSep & FrzTern1DesTutte & sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
                     Space(9) & sSep & FormatSpace(StringaNumeri(aTern2D,,True),8) & sSep & _
                     FrzTern2DesRuota & sSep & FrzTern2DesTutte & sSep,,,,vbCyan
                     Rem rigo 4
                     Scrivi LineasTit,,,,vbCyan
                  Else
                     Scrivi " |   " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
                     FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem  Rigo 2
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
                     Scrivi "D ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 3
                     Scrivi " |   " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
                     Space(9) & sSep,,0,,vbCyan
                     Scrivi String(8,"-"),,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,0,,vbCyan
                     Scrivi "-",,0,,vbRed
                     Scrivi sSep,,,,vbCyan
                     Rem rigo 4
                     Scrivi LineasTit,,,,vbCyan
                  End If ' controllo se sono entrambi pari o dispari
                  Scrivi
               End If ' Verifico che esistano gli estratti isotopi
               If ScriptInterrotto Then Exit For
            Next ' p
            If ScriptInterrotto Then Exit For
         End If ' verifico se l estrazione esiste
      Next ' R
      If ScriptInterrotto Then Exit For
      Call AvanzamentoElab(Ini,Fin,IdEstr)
   Next ' idestr
   Scrivi : Scrivi
   Scrivi "  Info su : https://forum.lottoced.com/threads/terno-metodo-camaleonte.2191331/",1,,,RGB(255,128,0)
   Scrivi "  Info su : https://forum.lottoced.com/threads/camaleonte-in-terno-secco.96329/",1,,,RGB(255,128,0)
   Scrivi
   Scrivi " ",,0
   Scrivi FormatSpace(" ",82),,,vbCyan
   Scrivi " ",,0
   Scrivi FormatSpace("  RESOCONTO SU :                          |   " & StringaRuote(aRuSpia),80) & "  ",,,vbCyan
   Scrivi
   Scrivi "  Range Concorsi analizzati:               |  " & Ini & " - " & Fin,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Estrazioni di verifica Metodo Aldini:    |  " & nClp ,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero Casi Totali:                      |  " & nCasiTro,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero casi Giocabili a sinistra:        |  " & nCasiSin,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Ambi a Ruota a Sinistra:                 |  " & FrzAsinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi a Tutte a Sinistra:                 |  " & FrezAsinTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Ruota:              |  " & PresFormAmboS_Ru,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Tutte:              |  " & PresFormAmboS_TT,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Ruota a Sinistra:    |  " & FrzTern1SinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Tutte a Sinistra:    |  " & FrzTern1SinTutteTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Ruota a Sinistra:    |  " & FrzTern2SinRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Tutte a Sinistra:    |  " & FrzTern2SinTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Ruota: |  " & PresFormTerS_Ru,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Tutte: |  " & PresFormTerS_TT,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Numero casi Giocabili a Destra:          |  " & nCasiDes,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
   Scrivi "  Ambi a Ruota a Destra:                   |  " & FrzADesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi a Tutte a Destra:                   |  " & FrzAdesTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Ruota:              |  " & PresFormAmboD_Ru,,,,vbCyan
   Scrivi "  Casi Coperti Ambi su Tutte:              |  " & PresFormAmboD_TT,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Ruota a Destra:      |  " & FrzTern1DesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 1 a Tutte a Destra:      |  " & FrzTern1DesTutteTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Ruota a Destra:      |  " & FrzTern2DesRuotaTotale,,,,vbCyan
   Scrivi "  Ambi In Terzina 2 a Tutte a Destra:      |  " & FrzTern2DesTutteTotale,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Ruota: |  " & PresFormTerD_Ru,,,,vbCyan
   Scrivi "  Casi Coperti dalle due terzine su Tutte: |  " & PresFormTerD_TT,,,,vbCyan
   Scrivi "  ---------------------------------------------------------------------------------",,,,vbCyan
End Sub
Function Specchietto(aV)
   Dim R,s,s1,IdEstr,bRet,p,idR
   s = ""
   For R = 1 To 12
      If R = 11 Then R = 12
      s = s & Format2(R) & " )  " & SiglaRuota(R) & "... "
      s1 = ""
      For IdEstr = EstrazioneFin To EstrazioneFin - 9 Step - 1
         bRet = False
         For p = 1 To 5
            If Estratto(IdEstr,R,p) = Estratto(IdEstr - 1,R,p) Then bRet = True :Exit For
         Next 'p
         If bRet Then s1 = s1 & " x ":Else s1 = s1 & " 0 "
      Next 'idestr
      s = s & s1 & vbCrLf
   Next 'R
   idR = InputBox(s,"Seleziona Numero/i Ruota di Ricerca,separati da punto","1.2.3.4.5.6.7.8.9.10.12")
   If idR = "" Then Specchietto = False :Exit Function
   aV = Split("0." & idR,".")
   For p = 1 To UBound(aV)
      If isRuotaValidaLotto(aV(p)) And aV(p) <> 11 Then
         Specchietto = True
      Else
         Specchietto = False
         Exit For
      End If
   Next
End Function
Sub Calcola(E1p,E1S,E0p,E0s,aAmb,aTern1,aTern2)
   Dim op1:op1 = E1p + E1S
   Dim op2:op2 = Differenza(E0p,E0s)
   Dim op3:op3 = Fuori90((op1 + op2)/2)
   Dim op4:op4 = Fuori90(Differenza(op1,op3))
   Dim op5:op5 = Fuori90(op1 + 1)
   Dim op6:op6 = Fuori90(op1 + 2)
   aAmb = Array(0,op3,op4)
   aTern1 = Array(0,op3,op4,op5)
   aTern2 = Array(0,op3,op4,op6)
End Sub
X Vengio
grazie mille troppo gentile :)
dalla prova ok va bene grazie
 

Abitte

Advanced Member >PLATINUM PLUS<
:DAllora....da povera nonnina avvezza al cartapen e,memore degli antichi esperti,fedele al fuorinovanta...stasera ho fatto ambo in cinquina a BA 24-33 e terno in sestina col 90 messo al posto della differenza 0. Avendo lo scanner "morto" se volete vi metto gli estremi degli scontrini.....per chi fosse dubbioso ;)

p.s. naturalmente ho unificato le due previsioni del 61 in 5^ del 26 e 28 nov.
 
Ultima modifica:

vengio

Super Member >GOLD<
Grande Abitte, il coraggio delle proprie convinzioni, Comunque ho fatto una prova ed effettivamente nello storico (ultime 20 estrazioni) col fuori 90 è molto più performante,
 

vengio

Super Member >GOLD<
allora puoi fare uno script con il fuori 90 grazie
Codice:
Sub Main()
   Dim n(5)
   Dim x(5)
   Dim y(5)
   Dim nn(5)
   Dim xx(5)
   Dim yy(5)
   Dim z(6)
   Dim Ruotedigioco(12)
   Dim Poste(5)
   'Poste(1) = 3
   Poste(2) = 2
   Poste(3) = 1
   'Poste(4) = 0.7
   'Poste(5) = 0.3
   clp = 13
   Scrivi String(22," ") & " NUMERO RIPETUTO ISOTOPO IN 2 ESTRAZIONI CONSECUTIVE SULLA STESSA RUOTA"
   esaritroso = InputBox("Inserisci le estrazioni di controllo","",20)
   fin = EstrazioneFin
   ini = EstrazioneFin - esaritroso
   For es = ini To fin
      AvanzamentoElab ini,fin,es
      Messaggio(es)
      For r = 1 To 12
         If r = 11 Then r = 12
         For p = 1 To 5
            w = p - 1
            ww = p + 1
            If w = 0 Then w = 5
            If ww = 6 Then ww = 1
            a = Estratto(es - 1,r,p)
            b = Estratto(es,r,p)
            c = Estratto(es - 1,r,ww)
            d = Estratto(es,r,ww)
            e = Estratto(es - 1,r,w)
            f = Estratto(es,r,w)
            If a = b Then
               h = Differenza(c,d)
               i = Fuori90(a + b)
               g = Fuori90(i + h)
               k = Fuori90(g/2)
               j = Fuori90(Differenza(i,k))
               qq = Fuori90(k + j)
               ss = Fuori90(qq + 1)
               vv = Fuori90(qq + 2)
               If pari(c) = True And pari(d) = True Or dispari(c) = True And dispari(d) = True Then
                  xx(1) = j
                  xx(2) = k
                  xx(3) = ss
                  nn(1) = j
                  nn(2) = k
                  yy(1) = j
                  yy(2) = k
                  yy(4) = vv
                  Ruotedigioco(1) = r
                  'Ruotedigioco(2) = 11
                  Scrivi String(110,"*"),1,,,4
                  Scrivi DataEstrazione(es - 1) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es - 1,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(a) & " in " & p & "° Posizione ",1
                  ColoreTesto 1:Scrivi DataEstrazione(es) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(b) & " in " & p & "° Posizione(Ripetuto in estrazione consecutiva)",1
                  Scrivi Format2(j) & " " & Format2(k) & " " & Format2(ss) & " " & Format2(vv) & " Posizione destra  " & c & " e " & d,1,,,10
                  Scrivi String(110,"*")
                  ImpostaGiocata 4,nn,Ruotedigioco,Poste,clp
                  ImpostaGiocata 5,xx,Ruotedigioco,Poste,clp
                  ImpostaGiocata 6,yy,Ruotedigioco,Poste,clp
                  Gioca es,1
                  'Scrivi String(110,"*"),1
                  ' _______________________________________________________________
                  l = Differenza(e,f)
                  m = Fuori90(i + l)
                  u = Fuori90(m/2)
                  o = Fuori90(Differenza(i,u))
                  q = Fuori90(U + o)
                  s = Fuori90(q + 1)
                  v = Fuori90(q + 2)
                  If pari(e) And pari(f) = True Or dispari(e) And dispari(f) = True Then
                     x(1) = u
                     x(2) = o
                     x(3) = s
                     n(1) = u
                     n(2) = o
                     y(1) = u
                     y(2) = o
                     y(4) = v
                     'Scrivi String(110,"*"),1
                     Scrivi DataEstrazione(es - 1) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es - 1,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(a) & " in " & p & "° Posizione ",1
                     ColoreTesto 1:Scrivi DataEstrazione(es) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(b) & " in " & p & "° Posizione(Ripetuto in estrazione consecutiva)",1
                     Scrivi Format2(u) & " " & Format2(o) & " " & Format2(s) & " " & Format2(v) & " Posizione sinistra  " & e & " e " & f,1,,,10
                     'Scrivi
                     Scrivi String(110,"*")
                     Ruotedigioco(1) = r
                     'Ruotedigioco(2) = 11
                     ImpostaGiocata 1,n,Ruotedigioco,Poste,clp
                     ImpostaGiocata 2,x,Ruotedigioco,Poste,clp
                     ImpostaGiocata 3,y,Ruotedigioco,Poste,clp
                     ImpostaGiocata 4,y,Ruotedigioco,Poste,clp
                     Gioca es,1
                     If pari(c + d) = True And pari(e + f) = True Then
                        z(1) = j
                        z(2) = k
                        z(3) = u
                        z(4) = o
                        z(5) = s
                        z(6) = v
                        Scrivi String(110,"*"),,,,10
                        Scrivi Format2(j) & " " & Format2(k) & " " & Format2(u) & " " & Format2(o) & " " & Format2(s) & " " & Format2(v) & " Combinata ",1,,,10
                        Scrivi String(110,"*"),1,,,10
                        Ruotedigioco(1) = r
                        'Ruotedigioco(2) = 11
                        ImpostaGiocata 1,z,Ruotedigioco,Poste,clp
                        Gioca es,1
                     End If
                  End If
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit For
   Next
   ScriviResoconto
End Sub
Inserita anche la sestina.
 

Alberto Anderlini

Super member
Codice:
Sub Main()
   Dim n(5)
   Dim x(5)
   Dim y(5)
   Dim nn(5)
   Dim xx(5)
   Dim yy(5)
   Dim z(6)
   Dim Ruotedigioco(12)
   Dim Poste(5)
   'Poste(1) = 3
   Poste(2) = 2
   Poste(3) = 1
   'Poste(4) = 0.7
   'Poste(5) = 0.3
   clp = 13
   Scrivi String(22," ") & " NUMERO RIPETUTO ISOTOPO IN 2 ESTRAZIONI CONSECUTIVE SULLA STESSA RUOTA"
   esaritroso = InputBox("Inserisci le estrazioni di controllo","",20)
   fin = EstrazioneFin
   ini = EstrazioneFin - esaritroso
   For es = ini To fin
      AvanzamentoElab ini,fin,es
      Messaggio(es)
      For r = 1 To 12
         If r = 11 Then r = 12
         For p = 1 To 5
            w = p - 1
            ww = p + 1
            If w = 0 Then w = 5
            If ww = 6 Then ww = 1
            a = Estratto(es - 1,r,p)
            b = Estratto(es,r,p)
            c = Estratto(es - 1,r,ww)
            d = Estratto(es,r,ww)
            e = Estratto(es - 1,r,w)
            f = Estratto(es,r,w)
            If a = b Then
               h = Differenza(c,d)
               i = Fuori90(a + b)
               g = Fuori90(i + h)
               k = Fuori90(g/2)
               j = Fuori90(Differenza(i,k))
               qq = Fuori90(k + j)
               ss = Fuori90(qq + 1)
               vv = Fuori90(qq + 2)
               If pari(c) = True And pari(d) = True Or dispari(c) = True And dispari(d) = True Then
                  xx(1) = j
                  xx(2) = k
                  xx(3) = ss
                  nn(1) = j
                  nn(2) = k
                  yy(1) = j
                  yy(2) = k
                  yy(4) = vv
                  Ruotedigioco(1) = r
                  'Ruotedigioco(2) = 11
                  Scrivi String(110,"*"),1,,,4
                  Scrivi DataEstrazione(es - 1) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es - 1,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(a) & " in " & p & "° Posizione ",1
                  ColoreTesto 1:Scrivi DataEstrazione(es) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(b) & " in " & p & "° Posizione(Ripetuto in estrazione consecutiva)",1
                  Scrivi Format2(j) & " " & Format2(k) & " " & Format2(ss) & " " & Format2(vv) & " Posizione destra  " & c & " e " & d,1,,,10
                  Scrivi String(110,"*")
                  ImpostaGiocata 4,nn,Ruotedigioco,Poste,clp
                  ImpostaGiocata 5,xx,Ruotedigioco,Poste,clp
                  ImpostaGiocata 6,yy,Ruotedigioco,Poste,clp
                  Gioca es,1
                  'Scrivi String(110,"*"),1
                  ' _______________________________________________________________
                  l = Differenza(e,f)
                  m = Fuori90(i + l)
                  u = Fuori90(m/2)
                  o = Fuori90(Differenza(i,u))
                  q = Fuori90(U + o)
                  s = Fuori90(q + 1)
                  v = Fuori90(q + 2)
                  If pari(e) And pari(f) = True Or dispari(e) And dispari(f) = True Then
                     x(1) = u
                     x(2) = o
                     x(3) = s
                     n(1) = u
                     n(2) = o
                     y(1) = u
                     y(2) = o
                     y(4) = v
                     'Scrivi String(110,"*"),1
                     Scrivi DataEstrazione(es - 1) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es - 1,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(a) & " in " & p & "° Posizione ",1
                     ColoreTesto 1:Scrivi DataEstrazione(es) & "   " & SiglaRuota(r) & "  " & StringaEstratti(es,(r)) & "      " & Left(SiglaRuota(r),3) & " " & Format2(b) & " in " & p & "° Posizione(Ripetuto in estrazione consecutiva)",1
                     Scrivi Format2(u) & " " & Format2(o) & " " & Format2(s) & " " & Format2(v) & " Posizione sinistra  " & e & " e " & f,1,,,10
                     'Scrivi
                     Scrivi String(110,"*")
                     Ruotedigioco(1) = r
                     'Ruotedigioco(2) = 11
                     ImpostaGiocata 1,n,Ruotedigioco,Poste,clp
                     ImpostaGiocata 2,x,Ruotedigioco,Poste,clp
                     ImpostaGiocata 3,y,Ruotedigioco,Poste,clp
                     ImpostaGiocata 4,y,Ruotedigioco,Poste,clp
                     Gioca es,1
                     If pari(c + d) = True And pari(e + f) = True Then
                        z(1) = j
                        z(2) = k
                        z(3) = u
                        z(4) = o
                        z(5) = s
                        z(6) = v
                        Scrivi String(110,"*"),,,,10
                        Scrivi Format2(j) & " " & Format2(k) & " " & Format2(u) & " " & Format2(o) & " " & Format2(s) & " " & Format2(v) & " Combinata ",1,,,10
                        Scrivi String(110,"*"),1,,,10
                        Ruotedigioco(1) = r
                        'Ruotedigioco(2) = 11
                        ImpostaGiocata 1,z,Ruotedigioco,Poste,clp
                        Gioca es,1
                     End If
                  End If
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit For
   Next
   ScriviResoconto
End Sub
Inserita anche la sestina.
GRAZIE
 

Abitte

Advanced Member >PLATINUM PLUS<
ci sarebbero due casi da giocare....chi ha lo script può controllare ed eventualmente dare indicazioni di gioco? Sono a MI col 50 e a NA coll'80. Grazie e Buone Feste a tutti
 

vengio

Super Member >GOLD<
ci sarebbero due casi da giocare....chi ha lo script può controllare ed eventualmente dare indicazioni di gioco? Sono a MI col 50 e a NA coll'80. Grazie e Buone Feste a tutti
19.12.2019 NA 75.89.71.80.48 NA 80 in 4° Posizione
21.12.2019 NA 70.33.10.80.12 NA 80 in 4° Posizione(Ripetuto in estrazione consecutiva)
62 08 71 72 Posizione destra 48 e 12
**************************************************************************************************************
Estrazione generatrice del pronostico 09724 [153 - 21/12/2019]
G 0004 Numeri in gioco : 62.08 su NA TT per Ambo,Terno

In corso per altre 13 estrazioni
G 0005 Numeri in gioco : 62.08.71 su NA TT per Ambo,Terno
In corso per altre 13 estrazioni
G 0006 Numeri in gioco : 62.08.72 su NA TT per Ambo,Terno
In corso per altre 13 estrazioni
Ciao Abitte, risulta solo 80 a NA, 50 a MI non è ripetuto.
 

Abitte

Advanced Member >PLATINUM PLUS<
C'è anche MILANO..... 10/12 3-50 4^ e 5^ pos 12/12 43-50 4^ e 5^ pos

Grazie per la risposta su NA
 

vengio

Super Member >GOLD<
10.12.2019 MI 37.22.09.03.50 MI 50 in 5° Posizione
12.12.2019 MI 40.47.64.43.50 MI 50 in 5° Posizione(Ripetuto in estrazione consecutiva)
30 70 11 12 Posizione sinistra 3 e 43
**************************************************************************************************************
Estrazione generatrice del pronostico 09720 [149 - 12/12/2019]
G 0001 Numeri in gioco : 30.70 su MI per Ambo,Terno

In corso per altre 9 estrazioni
G 0002 Numeri in gioco : 30.70.11 su MI per Ambo,Terno
In corso per altre 9 estrazioni
G 0003 Numeri in gioco : 30.70.12 su MI per Ambo,Terno
In corso per altre 9 estrazioni
Effettivamente, Abitte, hai ragione tu e lo script non me lo rilelevava a differenza di quello diI legend. Questo è l'output.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 marzo 2024
    Bari
    30
    51
    17
    01
    53
    Cagliari
    13
    70
    25
    68
    47
    Firenze
    28
    30
    54
    70
    88
    Genova
    67
    87
    22
    03
    62
    Milano
    22
    34
    13
    47
    24
    Napoli
    20
    72
    59
    01
    52
    Palermo
    05
    72
    65
    52
    32
    Roma
    28
    43
    75
    54
    87
    Torino
    16
    08
    17
    24
    38
    Venezia
    67
    28
    55
    60
    29
    Nazionale
    15
    69
    22
    63
    39
    Estrazione Simbolotto
    Firenze
    44
    09
    31
    22
    16
Alto