Cerco

solare · 27 Gennaio 2016

Ciao, cerco un listato che mi visualizzi tutti i numeri consecutivi

i legend · 27 Gennaio 2016

Ciao , Puoi spiegare meglio cosa ti occorre? Ti serve su estrazione unica oppure un tot di estrazioni? Vuoi visualizzare solo le estrazioni o fare anche dei calcoli? Non so se ci sia già in circolazione ma se vuoi si puo scrivere ciao

solare · 28 Gennaio 2016

Ciao i legend, grazie per l'interessamento.
Vorrei che il listato trovasse un ambo in decina consecutivo e faccia il +1 e -1 es. se trovo 12-13 mettero in gioco 11-12-13-14 sulla ruota interessata.
stessa cosa cosa se sortisce l'ambo isotopo in due ruote es. ba 82 ca 83 giocherò su ba ca 81-82-83-84 la ricerca può fare riferimento o solo l'ultima estrazione oppure le ultime 18 estrazioni come vuoi.

i legend · 28 Gennaio 2016

Ciao solare ho fatto lo script di ricerca sulla stessa ruota ; appena possibile lo posto.ma come vedrai i casi sono troppi nella medesima estrazione dobbiamo inserire dei filtri .pensaci su.
Quando vedrai l output magari ti verranno nuove idee.
A dopo.

solare · 28 Gennaio 2016

Ok intanto grazie

i legend · 28 Gennaio 2016

Ciao Solare Prova a controllare se lo script fa la ricerca correttamente
allora se imposti
>=0 scrive tutte le ruote
>=1 scrive tutte le ruote che hanno almeno un consecutivo o più
>=2 scrive tutte le ruote che hanno almeno due consecutivo o più
>=3 come sopra almeno tre

Codice:

Option Explicit
Sub Main
    'Salvo Errori ecco lo script
    'controllare che i dati in output siano corretti
    'controllare che siano visualizzati tutti i casi ricercati
    'script x lotto ced
    Dim Ruota
    Dim Idestr,M
    Dim iCons,sCons,qCons
    Dim qEstr :qEstr = Int(InputBox("Quante Estrazioni vuoi esaminare?","Inserisci Numero Estrazioni",18)) - 1
    ReDim aRuote(0)
    Idestr = EstrazioneFin
    qCons = qConsec
    Scrivi FormatSpace("   Data Estrazione ",25) & FormatSpace("|Ru",4) & "|" & FormatSpace("  Estratti    |",15) & FormatSpace("  Cons  ",5) & FormatSpace("|    Numeri Consecutivi    ",30),True,True,vbBlue,vbWhite
    M = 0
    For Idestr = EstrazioneFin - qEstr To EstrazioneFin
        For Ruota = 1 To 11
            If Ruota = 11 Then Ruota = 12
            sCons = GetConsecutivi(Idestr,Ruota,iCons)
            If iCons >= qCons Then
                M = M + 1
                Call GetTab(M,Idestr,Ruota,iCons,sCons)
            End If
        Next
        Call Messaggio(DataEstrazione(Idestr))
    Next
    Scrivi "Numero Casi : " & M
End Sub
Function GetConsecutivi(IdEstr,Ruota,iCons)
    Dim P,P1
    Dim E,E1
    Dim sCons
    iCons = 0
    sCons = ""
    For P = 1 To 4
        E = Estratto(IdEstr,Ruota,P)
        For P1 = P + 1 To 5
            E1 = Estratto(IdEstr,Ruota,P1)
            If Distanza(E,E1) = 1 Then
                iCons = iCons + 1
                sCons = sCons & "[" & Format2(E) & ";" & Format2(E1) & "]"
            End If
        Next
    Next
    GetConsecutivi = sCons
End Function
Function qConsec
    Dim aCons
    aCons = Array(0,1,2,3)
    qConsec = ScegliOpzioneMenu(aCons,0,"Quanti Consecutivi >= ")
End Function
Sub GetTab(M,IdEstr,Ruota,iCons,sCons)
    If pari(M) Then
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(234,254,226),vbBlue
        Scrivi SiglaRuota(Ruota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "     " & iCons & "     " & FormatSpace(sCons,28),True,True,RGB(234,254,226),vbBlue
    Else
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(255,206,255)
        Scrivi SiglaRuota(Ruota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "     " & iCons & "     " & FormatSpace(sCons,28),True,,RGB(255,206,255)
    End If
End Sub

Una volta che verifichi che lo script sia corretto pensa ad ulteriori filtri
Ciao

solare · 28 Gennaio 2016

Ok perfetto.
C'è la possibilità di effettuare la stessa ricerca ma in verticale ?
cioè in due ruote es. bari 72 cagliari 73
se non è possibile grazie lo stesso
sei stato fin troppo gentile.

i legend · 28 Gennaio 2016

Ciao Solare sicuramente si può fare ,ma preferirei continuare a lavorare su questo , per filtrare ulteriormente i casi se ti va ovviamente, altrimenti se preferisci ti listo la ricerca in veriticale.
fammi sapere

solare · 28 Gennaio 2016

Se puoi avrei piacere avere la ricerca in verticale e poi eventualmente possiamo vedere ulteriori miglioramenti.
Grazie ancora

i legend · 28 Gennaio 2016

Ok lo script l ho finito , ma avendo come base il primo ora il codice è bruttissimo.dato che devo riconcepirlo completamente, se mi spieghi tutto ora so cosa devo fare senza ripensarlo in seguito, oppure se ti basta la ricerca listo quello appena fatto.
Appena mi fai sapere , mi metto a lavoro

Ciao

solare · 28 Gennaio 2016

A me basta la ricerca ma se vuoi aggiungere il +1 e -1 all'ambo in modo da mettere in gioco la quartina sulle due ruote Ti riporto un es. trovo 15 a ba e 16 a ca gioco sulle due ruote 14-15-16-17.

i legend · 28 Gennaio 2016

Ciao Solare se ti serve solo trovare i casi allora è inutile che riscrivo tutto
Ti posto il codice che ho scritto in precedenza anche se non mi piace.
Per favore controlla che i risultati siano esatti
Salvo Errori ed omissis ecco lo script

Codice:

  Option Explicit
Sub Main
'Salvo Errori Ed Omissis
'Controllare se lo script rivela tutti i casi
'controllare se l'output restituiti sia corretto
'Qualora  lo script funzioni correttamente  rivela  l accadimento dei casi, non restituisce previsioni
'scripto per Utente Solare Forum LottoCed
    Dim aVociAlg(5)
    Dim qEstr :qEstr = Int(InputBox("Quante Estrazioni vuoi esaminare?","Inserisci Numero Estrazioni",18)) - 1
    Dim IdAlg :IdAlg = GetAlgoritmo(aVociAlg)
    Dim qCons :qCons = qConsec
    Dim To_Ruote : To_Ruote = GetSecRuota(IdAlg)
    Dim Dist :Dist=GetDistanzaCiclometrica
    Dim Ruota,IdEstr,Riga
    Dim iCons,sCons
    Scrivi "Distanza Ciclometrica : "&Dist
    Call ScriviAlgoritmo(IdAlg,aVociAlg)
    Call GetTitoli(IdAlg)
    Riga = 0
    For IdEstr = EstrazioneFin - qEstr To EstrazioneFin
        For Ruota = 1 To To_Ruote
            If Ruota = 11 Then Ruota = 12
            Call GetAlgoritmoDist(IdEstr,Ruota,IdAlg,Dist,iCons,sCons)
            If iCons >= qCons Then
                Riga = Riga + 1
                Call GetTabIdAlg(Riga,IdEstr,IdAlg,Ruota,iCons,sCons)
            End If
        Next
        Call Messaggio(DataEstrazione(IdEstr))
    Next
    Scrivi "Numero Casi : " & Riga
End Sub
Function GetAlgoritmo(aVoci)
    
    aVoci(1) = "Numeri Consecutivi Oriz tutte le Ruote"
    aVoci(2) = "Numeri Consecutivi oriz PosCons tutte le Ruote"
    aVoci(3) = "Numeri Consecutivi Vert Ruote Consecutive"
    aVoci(4) = "Numeri Consecutivi Vert Ruote Diametrali"
    aVoci(5) = "Numeri Consecutivi Vert Ruote Gemelle"
    GetAlgoritmo = ScegliOpzioneMenu(aVoci,1,"SelezionaTipoRicerca")
End Function
Function ScriviAlgoritmo(idalg,aVociAlg)
    Scrivi aVociAlg(idalg)
End Function
Function GetSecRuota(idAlg)
    Dim bRet
    Select Case idAlg
    Case 1,2,3
        bRet = 11
    Case 4,5
        bRet = 5
    End Select
    GetSecRuota = bRet
End Function
Function qConsec
    Dim aCons
    aCons = Array(0,1,2,3)
    qConsec = ScegliOpzioneMenu(aCons,0,"Quanti Consecutivi >= ")
End Function
Function GetDistanzaCiclometrica
Dim aDist(44)
Dim i
For i=0 To UBound(aDist)
aDist(i)=i+1
Next
GetDistanzaCiclometrica=ScegliOpzioneMenu(aDist,0,"Distanza Ciclometrica di Ricerca")+1
End Function
Sub NumeriConsecutiviOriztutteleRuote(IdEstr,Ruota,Dist,iCons,sCons)
    Dim p,p1,E,E1
    sCons = ""
    iCons = 0
    For p = 1 To 4
        E = Estratto(IdEstr,Ruota,p)
        For p1 = p + 1 To 5
            E1 = Estratto(IdEstr,Ruota,p1)
            If Distanza(E,E1) = Dist Then
                iCons = iCons + 1
                sCons = sCons & "[" & Format2(E) & ";" & Format2(E1) & "]"
            End If
        Next
    Next
End Sub
Sub NumeriConsecutiviOrizPosConsTutteLeRuote(IdEstr,Ruota,Dist,iCons,sCons)
    Dim p,p1,E,E1
    sCons = ""
    iCons = 0
    For p = 1 To 4
        E = Estratto(IdEstr,Ruota,p)
        p1 = p + 1
        E1 = Estratto(IdEstr,Ruota,p1)
        If Distanza(E,E1) = Dist Then
            iCons = iCons + 1
            sCons = sCons & "[" & Format2(E) & ";" & Format2(E1) & "]"
        End If
    Next
End Sub
Sub NumeriConsecutiviVerticaliRuote(IdEstr,Ruota,SecRuota,Dist,iCons,sCons)
    Dim p,E,E1
    sCons = ""
    iCons = 0
    If Estratto(IdEstr,Ruota,1)>0 And Estratto(IdEstr,SecRuota,1)>0 Then
    For p = 1 To 5
        E = Estratto(IdEstr,Ruota,p)
        E1 = Estratto(IdEstr,SecRuota,p)
        If Distanza(E,E1) = Dist Then
            iCons = iCons + 1
            sCons = sCons & "[" & Format2(E) & ";" & Format2(E1) & "]"
        End If
    Next
    End If
End Sub
Sub GetAlgoritmoDist(IdEstr,Ruota,IdAlg,Dist,iCons,sCons)
    Dim SecRuota
    Select Case IdAlg
    Case 1
        Call NumeriConsecutiviOriztutteleRuote(IdEstr,Ruota,Dist,iCons,sCons)
    Case 2
        Call NumeriConsecutiviOrizPosConsTutteLeRuote(IdEstr,Ruota,Dist,iCons,sCons)
    Case 3
        SecRuota = Ruota + 1
        If SecRuota = 11 Then SecRuota = 12
        If SecRuota = 13 Then SecRuota = 1
        Call NumeriConsecutiviVerticaliRuote(IdEstr,Ruota,SecRuota,Dist,iCons,sCons)
    Case 4
        SecRuota = RuotaDiametrale(Ruota)
        Call NumeriConsecutiviVerticaliRuote(IdEstr,Ruota,SecRuota,Dist,iCons,sCons)
    Case 5
        SecRuota = RuotaGemella(Ruota)
        Call NumeriConsecutiviVerticaliRuote(IdEstr,Ruota,SecRuota,Dist,iCons,sCons)
    End Select
    
End Sub
Sub GetTitoli(idAlg)
    Select Case idAlg
    Case 1,2
        Scrivi FormatSpace("   Data Estrazione ",25) & FormatSpace("|Ru",4) & "|" & FormatSpace("  Estratti    |",15) & FormatSpace("  Cons  ",5) & FormatSpace("|    Numeri Consecutivi    ",30),True,True,vbBlue,vbWhite
    Case 3,4,5
        Scrivi FormatSpace("   Data Estrazione ",25) & FormatSpace("|  Ru",6) & "|" & FormatSpace("  EstrattiR1   |  EstrattiR2   |",30) & FormatSpace("  Cons  ",5) & FormatSpace("|    Numeri Consecutivi    ",31),True,True,vbBlue,vbWhite
    End Select
End Sub
Sub GetRigaTabRuotaSingola(Riga,IdEstr,IdAlg,Ruota,iCons,sCons)
    If pari(Riga) Then
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(234,254,226),vbBlue
        Scrivi SiglaRuota(Ruota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "     " & iCons & "     " & FormatSpace(sCons,28),True,True,RGB(234,254,226),vbBlue
    Else
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(255,206,255)
        Scrivi SiglaRuota(Ruota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "     " & iCons & "     " & FormatSpace(sCons,28),True,,RGB(255,206,255)
    End If
End Sub
Sub GetRigaTabDueRuote(Riga,IdEstr,Ruota,SecRuota,iCons,sCons)
    If pari(Riga) Then
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(234,254,226),vbBlue
        Scrivi SiglaRuota(Ruota) & "-" & SiglaRuota(SecRuota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "  " & FormatSpace(StringaEstratti(IdEstr,SecRuota),"-",14) & "     " & iCons & "     " & FormatSpace(sCons,29),True,True,RGB(234,254,226),vbBlue
    Else
        Scrivi GetInfoEstrazione(IdEstr) & "  ",True,False,RGB(255,206,255)
        Scrivi SiglaRuota(Ruota) & "-" & SiglaRuota(SecRuota) & "  " & FormatSpace(StringaEstratti(IdEstr,Ruota,"-"),14) & "  " & FormatSpace(StringaEstratti(IdEstr,SecRuota),"-",14) & "     " & iCons & "     " & FormatSpace(sCons,29),True,,RGB(255,206,255)
    End If
End Sub
Sub GetTabIdAlg(Riga,IdEstr,idAlg,Ruota,iCons,sCons)
    Dim SecRuota
    Select Case idAlg
    Case 1,2
        Call GetRigaTabRuotaSingola(Riga,IdEstr,idAlg,Ruota,iCons,sCons)
    Case 3
        SecRuota = Ruota + 1
        If SecRuota = 11 Then SecRuota = 12
        If SecRuota = 13 Then SecRuota = 1
        Call GetRigaTabDueRuote(Riga,IdEstr,Ruota,SecRuota,iCons,sCons)
    Case 4
        SecRuota = RuotaDiametrale(Ruota)
        Call GetRigaTabDueRuote(Riga,IdEstr,Ruota,SecRuota,iCons,sCons)
    Case 5
        SecRuota = RuotaGemella(Ruota)
        Call GetRigaTabDueRuote(Riga,IdEstr,Ruota,SecRuota,iCons,sCons)
    End Select
End Sub

Ciao Fammi sapere per favore se i risultati sono esatti o se devo correggere qualcosa

i legend · 29 Gennaio 2016

Qualcuno può dirmi per favore se ha verificato che lo script vada bene?
Grazie

solare · 29 Gennaio 2016

Ciao I legend scusa ma non mi sono collegato prima.
ho provato tutto ok
Grazie

i legend · 29 Gennaio 2016

Ciao solare grazie.

Cerca

Cerca

Cerco

solare

Advanced Member >PLATINUM<

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

i legend

Premium Member

solare

Advanced Member >PLATINUM<

i legend

Premium Member

Ultima estrazione Lotto

Ultimi Messaggi