Novità

listato non funziona

solare

Advanced Member >PLATINUM<
Sub Main
''''' combinazioni a scelta naMe script MIKIaSceltaAmbo
'''' esplode x single / coppie e/o terzine combinazione richiesta
Dim numeri(13)
Dim art(1)
Dim r
Dim combinazione
Dim lancia
Dim des
Dim nsorte

fine = EstrazioneFin
Ord = InputBox("Ordinamento discendente per (Rit.Att. = 3) (Ritardo Max = 4) (Frequenza = 5 ) (Rit.Glob. = 6)",,6)
r = InputBox("Scegli Ruota ",,1)
art(1) = r
svi = InputBox("Sviluppo in Single - Ambo o Terno (S - A - T) ",,"S")
te = ""
If svi = "S" Or svi = "s" Then te = "Single"
If svi = "A" Or svi = "a" Then te = "Coppie"
If svi = "T" Or svi = "t" Then te = "Terzine"
des = ""
nsorte = InputBox("Sorte 1=Ambata 2=Ambo ",,1)
If nsorte = 1 Then des = " 1 = Ambata "
If nsorte = 2 Then des = " 2 = Ambo "

'scelgo numeri combinazione di ricerca
Call ScegliNumeri(numeri)
qtn = UBound(numeri)
combinazione = ""
c = 0
For c = c + 1 To qtn
combinazione = combinazione & Format2(numeri(c)) & " "
Next
Scrivi " Statistica effettuata all'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
Scrivi " Sviluppa combinazione Integrale namescript MIKIaScelta "
Scrivi " Combinazione di numeri inseriti..." & combinazione,1,- 1,- 1
Scrivi " Hai scelto lo sviluppo in " & te & " per la sorte " & des,1,- 1
Scrivi "______________________________________________________________________"
Scrivi

'scompongo combinazione numeri
ReDim aV(0)
Call SplitByChar(numeri(1),"-",aV)

ReDim atitoli(16)
' preimposto i titoli delle colonne
atitoli(1) = "Ruota "
atitoli(2) = "Numeri "
atitoli(3) = "Rit.att"
atitoli(4) = " Rit.Max"
atitoli(5) = " Freque "
atitoli(6) = " Rit.Glob."
atitoli(7) = " Rit.01 "
atitoli(8) = " Rit.02 "
atitoli(9) = " Rit.03 "
atitoli(10) = " Rit.04 "
atitoli(11) = " Rit.05 "
atitoli(12) = " Rit.06 "
atitoli(13) = " Rit.07 "
atitoli(14) = " Rit.08 "
atitoli(15) = " Rit.09 "
atitoli(16) = " Rit.10 "

' inizializzo la tabella
Call InitTabella(atitoli,1,,,5)
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in Single
If svi = "S" Or svi = "s" Then
da = 0
For da = da + 1 To qtn
ReDim nx(1)
nx(1) = Format2(numeri(da))
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next

'''' e riepilogo combinazione intera
da = 0
ReDim nx(13)
For da = da + 1 To qtn
nx(da) = Format2(numeri(da))
Next
lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)

End If
'''''---------------------------------------------------------------------------------------------------------
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in ambi
If svi = "A" Or svi = "a" Then
da = 0
a = 0
For da = da + 1 To qtn - 1
a = da
For a = a + 1 To qtn
ReDim nx(2)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))

lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)

Next
Next
End If
'''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in terzine
If svi = "T" Or svi = "t" Then
da = 0
a = 0
af = 0
For da = da + 1 To qtn - 2
a = da
For a = a + 1 To qtn - 1
af = a
For af = af + 1 To qtn

ReDim nx(3)
nx(1) = Format2(numeri(da))
nx(2) = Format2(numeri(a))
nx(3) = Format2(numeri(af))

lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)

Next
Next
Next
End If

Call CreaTabella(Int(ord))
End Sub

''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,fine,nsorte)

'''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
'''' somma ritardi in ritardo globale e ricerca il ritardo attuale
'''' mette in tabella ed ordina per ritardo globale discendente
somrit = 0
ReDim an(13)
For q = 1 To UBound(nx)
an(q) = Format2(nx(q))
Next

' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDim aValori(16) '
aValori(1) = NomeRuota(r)
If UBound(nx) = 1 Then aValori(2) = an(1)
If UBound(nx) > 1 And UBound(nx) < 4 Then aValori(2) = an(1) & " " & an(2) & " " & an(3)
If UBound(nx) > 3 Then aValori(2) = an(1) & " " & an(2) & " " & an(3) & " " & an(4) & " " & an(5) & " " & an(6) & " " & an(7) & " " & an(8) & " " & an(9) & " " & an(10) & " " & an(11) & " " & an(12) & " " & an(13)

Call AddNumeriToGruppoStatistico(an,r)
Call StatisticaGruppoFormazioni(nsorte,RetRitardo,RetRitardoMax,Freq,sRetFormaz,EstrazioneIni,fine)
aValori(3) = RetRitardo
aValori(4) = RetRitardoMax
aValori(5) = Freq


Call ElencoRitardi(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
last10 = UBound(aRetRitardi) - 10
last = UBound(aRetRitardi)


f1 = 0
f = 6
For f1 = f1 + 1 To 10
aValori(f + f1) = aRetRitardi(last - f1)
somrit = somrit + aRetRitardi(last - f1)
Next

aValori(6) = somrit


Call AddRigaTabella(aValori,Bianco_,"center",1)
Call SetColoreCella(6,vbYellow,vbBlue)
Call SetColoreCella(3,vbYellow,vbBlue)

If retRitardo >= RetRitardoMax Then
Call SetColoreCella(3,vbRed,vbWhite)
Call SetColoreCella(4,vbRed,vbWhite)

End If

GetRitardi = Lancia


End Function
''''------------------------------------------------------------------------------------------------------------------
 
prova cosi
SubMain
''''' combinazioni a scelta naMe script MIKIaSceltaAmbo
'''' esplode x single / coppie e/o terzine combinazione richiesta
Dimnumeri(13)
Dimart(1)
Dimr
Dimcombinazione
Dimlancia
Dimdes
Dimnsorte
fine =EstrazioneFin
Ord =InputBox("Ordinamento discendente per (Rit.Att. = 3) (Ritardo Max = 4) (Frequenza = 5 ) (Rit.Glob. = 6)",,6)
r=InputBox("Scegli Ruota ",,1)
art(1) =r
svi =InputBox("Sviluppo in Single - Ambo o Terno (S - A - T) ",,"S")
te = ""
If svi = "S" Or svi = "s" Then te = "Single"
If svi = "A" Or svi = "a" Then te = "Coppie"
If svi = "T" Or svi = "t" Then te = "Terzine"
des= ""
nsorte=InputBox("Sorte 1=Ambata 2=Ambo ",,1)
Ifnsorte= 1 Thendes= " 1 = Ambata "
Ifnsorte= 2 Thendes= " 2 = Ambo "
'scelgo numeri combinazione di ricerca
CallScegliNumeri(numeri)
qtn =UBound(numeri)
combinazione= ""
c = 0
For c = c + 1 To qtn
combinazione=combinazione&Format2(numeri(c)) & ""
Next
Scrivi " Statistica effettuata all'estrazione n. " &EstrazioneFin& " / " &DataEstrazione(EstrazioneFin),1,- 1,- 1
Scrivi " Sviluppa combinazione Integrale namescript MIKIaScelta "
Scrivi " Combinazione di numeri inseriti..." &combinazione,1,- 1,- 1
Scrivi " Hai scelto lo sviluppo in " & te & " per la sorte " &des,1,- 1
Scrivi "_________________________________________________ _____________________"
Scrivi
'scompongo combinazione numeri
ReDimaV(0)
CallSplitByChar(numeri(1),"-",aV)
ReDimatitoli(16)
' preimposto i titoli delle colonne
atitoli(1) = "Ruota "
atitoli(2) = "Numeri "
atitoli(3) = "Rit.att"
atitoli(4) = " Rit.Max"
atitoli(5) = " Freque "
atitoli(6) = " Rit.Glob."
atitoli(7) = " Rit.01 "
atitoli(8) = " Rit.02 "
atitoli(9) = " Rit.03 "
atitoli(10) = " Rit.04 "
atitoli(11) = " Rit.05 "
atitoli(12) = " Rit.06 "
atitoli(13) = " Rit.07 "
atitoli(14) = " Rit.08 "
atitoli(15) = " Rit.09 "
atitoli(16) = " Rit.10 "
' inizializzo la tabella
CallInitTabella(atitoli,1,,,5)
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in Single
If svi = "S" Or svi = "s" Then
da = 0
For da = da + 1 To qtn
ReDimnx(1)
nx(1) =Format2(numeri(da))
lancia=GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
'''' e riepilogo combinazione intera
da = 0
ReDimnx(13)
For da = da + 1 To qtn
nx(da) =Format2(numeri(da))
Next
lancia=GetRitardi(nx,r,combinazione,art,fine,nsorte)
EndIf
'''''---------------------------------------------------------------------------------------------------------
''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in ambi
If svi = "A" Or svi = "a" Then
da = 0
a = 0
For da = da + 1 To qtn - 1
a = da
For a = a + 1 To qtn
ReDimnx(2)
nx(1) =Format2(numeri(da))
nx(2) =Format2(numeri(a))
lancia=GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
EndIf
'''''---------------------------------------------------------------------------------------------------------
'''' sviluppo in terzine
If svi = "T" Or svi = "t" Then
da = 0
a = 0
af = 0
For da = da + 1 To qtn - 2
a = da
For a = a + 1 To qtn - 1
af = a
For af = af + 1 To qtn
ReDimnx(3)
nx(1) =Format2(numeri(da))
nx(2) =Format2(numeri(a))
nx(3) =Format2(numeri(af))
lancia=GetRitardi(nx,r,combinazione,art,fine,nsorte)
Next
Next
Next
EndIf
CallCreaTabella(Int(ord))
EndSub
''''-----------------------------------------------------------------------------------------------------------
FunctionGetRitardi(nx,r,combinazione,art,fine,nsorte)
'''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
'''' somma ritardi in ritardo globale e ricerca il ritardo attuale
'''' mette in tabella ed ordina per ritardo globale discendente
somrit = 0
ReDiman(13)
For q = 1 ToUBound(nx)
an(q) =Format2(nx(q))
Next
' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
ReDimaValori(16) '
aValori(1) =NomeRuota(r)
IfUBound(nx) = 1 ThenaValori(2) =an(1)
IfUBound(nx) > 1 AndUBound(nx) < 4 ThenaValori(2) =an(1) & "" &an(2) & "" &an(3)
IfUBound(nx) > 3 ThenaValori(2) =an(1) & "" &an(2) & "" &an(3) & "" &an(4) & "" &an(5) & "" &an(6) & "" &an(7) & "" &an(8) & "" &an(9) & "" &an(10) & "" &an(11) & "" &an(12) & "" &an(13)
CallAddNumeriToGruppoStatistico(an,r)
CallStatisticaGruppoFormazioni(nsorte,RetRitardo,RetRitardoMax,Freq,sRetFormaz,EstrazioneIni,fine)
aValori(3) = RetRitardo
aValori(4) = RetRitardoMax
aValori(5) = Freq
@
CallElencoRitardi(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
last10 =UBound(aRetRitardi) - 10
last =UBound(aRetRitardi)
@
f1 = 0
f = 6
For f1 = f1 + 1 To 10
aValori(f + f1) = aRetRitardi(last - f1)
somrit = somrit + aRetRitardi(last - f1)
Next
aValori(6) = somrit
@
CallAddRigaTabella(aValori,Bianco_,"center",1)
CallSetColoreCella(6,vbYellow,vbBlue)
CallSetColoreCella(3,vbYellow,vbBlue)
If retRitardo >= RetRitardoMax Then
CallSetColoreCella(3,vbRed,vbWhite)
CallSetColoreCella(4,vbRed,vbWhite)
EndIf
GetRitardi= Lancia
@
EndFunction
@
@
ciao garcid
 
Ultima modifica:
probabilmente su copia incolla è successo qualcosa comunque prova cambiare le 2 diciature: aRetRitardi RetRitardoMax con quelle sul tuo listato copia cosi come sono spero di non aver fatto casini garcid
 
Ultima modifica:
prova se va bene
Codice:
Sub Main
    ''''' combinazioni a scelta naMe script MIKIaSceltaAmbo
    '''' esplode x single / coppie e/o terzine combinazione richiesta
    Dim numeri(13)
    Dim art(1)
    Dim r
    Dim combinazione
    Dim lancia
    Dim des
    Dim nsorte
    fine = EstrazioneFin
    Ord = InputBox("Ordinamento discendente per (Rit.Att. = 3) (Ritardo Max = 4) (Frequenza = 5 ) (Rit.Glob. = 6)",,6)
    r = InputBox("Scegli Ruota ",,1)
    art(1) = r
    svi = InputBox("Sviluppo in Single - Ambo o Terno (S - A - T) ",,"S")
    te = ""
    If svi = "S" Or svi = "s" Then te = "Single"
    If svi = "A" Or svi = "a" Then te = "Coppie"
    If svi = "T" Or svi = "t" Then te = "Terzine"
    des = ""
    nsorte = InputBox("Sorte 1=Ambata 2=Ambo ",,1)
    If nsorte = 1 Then des = " 1 = Ambata "
    If nsorte = 2 Then des = " 2 = Ambo "
    'scelgo numeri combinazione di ricerca
    Call ScegliNumeri(numeri)
    qtn = UBound(numeri)
    combinazione = ""
    c = 0
    For c = c + 1 To qtn
        combinazione = combinazione & Format2(numeri(c)) & " "
    Next
    Scrivi " Statistica effettuata all'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
    Scrivi " Sviluppa combinazione Integrale namescript MIKIaScelta "
    Scrivi " Combinazione di numeri inseriti..." & combinazione,1,- 1,- 1
    Scrivi " Hai scelto lo sviluppo in " & te & " per la sorte " & des,1,- 1
    Scrivi "_________________________________________________ _____________________"
    Scrivi
    'scompongo combinazione numeri
    ReDim aV(0)
    Call SplitByChar(numeri(1),"-",aV)
    ReDim atitoli(16)
    ' preimposto i titoli delle colonne
    atitoli(1) = "Ruota "
    atitoli(2) = "Numeri "
    atitoli(3) = "Rit.att"
    atitoli(4) = " Rit.Max"
    atitoli(5) = " Freque "
    atitoli(6) = " Rit.Glob."
    atitoli(7) = " Rit.01 "
    atitoli(8) = " Rit.02 "
    atitoli(9) = " Rit.03 "
    atitoli(10) = " Rit.04 "
    atitoli(11) = " Rit.05 "
    atitoli(12) = " Rit.06 "
    atitoli(13) = " Rit.07 "
    atitoli(14) = " Rit.08 "
    atitoli(15) = " Rit.09 "
    atitoli(16) = " Rit.10 "
    ' inizializzo la tabella
    Call InitTabella(atitoli,1,,,5)
    ''''---------------------------------------------------------------------------------------------------------
    '''' sviluppo in Single
    If svi = "S" Or svi = "s" Then
        da = 0
        For da = da + 1 To qtn
            ReDim nx(1)
            nx(1) = Format2(numeri(da))
            lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
        Next
        '''' e riepilogo combinazione intera
        da = 0
        ReDim nx(13)
        For da = da + 1 To qtn
            nx(da) = Format2(numeri(da))
        Next
        lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
    End If
    '''''---------------------------------------------------------------------------------------------------------
    ''''---------------------------------------------------------------------------------------------------------
    '''' sviluppo in ambi
    If svi = "A" Or svi = "a" Then
        da = 0
        a = 0
        For da = da + 1 To qtn - 1
            a = da
            For a = a + 1 To qtn
                ReDim nx(2)
                nx(1) = Format2(numeri(da))
                nx(2) = Format2(numeri(a))
                lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
            Next
        Next
    End If
    '''''---------------------------------------------------------------------------------------------------------
    '''' sviluppo in terzine
    If svi = "T" Or svi = "t" Then
        da = 0
        a = 0
        af = 0
        For da = da + 1 To qtn - 2
            a = da
            For a = a + 1 To qtn - 1
                af = a
                For af = af + 1 To qtn
                    ReDim nx(3)
                    nx(1) = Format2(numeri(da))
                    nx(2) = Format2(numeri(a))
                    nx(3) = Format2(numeri(af))
                    lancia = GetRitardi(nx,r,combinazione,art,fine,nsorte)
                Next
            Next
        Next
    End If
    Call CreaTabella(Int(ord))
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,fine,nsorte)
    '''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
    '''' somma ritardi in ritardo globale e ricerca il ritardo attuale
    '''' mette in tabella ed ordina per ritardo globale discendente
    somrit = 0
    ReDim an(13)
    For q = 1 To UBound(nx)
        an(q) = Format2(nx(q))
    Next
    ' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
    ReDim aValori(16) '
    aValori(1) = NomeRuota(r)
    If UBound(nx) = 1 Then aValori(2) = an(1)
    If UBound(nx) > 1 And UBound(nx) < 4 Then aValori(2) = an(1) & " " & an(2) & " " & an(3)
    If UBound(nx) > 3 Then aValori(2) = an(1) & " " & an(2) & " " & an(3) & " " & an(4) & " " & an(5) & " " & an(6) & " " & an(7) & " " & an(8) & " " & an(9) & " " & an(10) & " " & an(11) & " " & an(12) & " " & an(13)
    Call AddNumeriToGruppoStatistico(an,r)
    Call StatisticaGruppoFormazioni(nsorte,RetRitardo,RetRitardoMax,Freq,sRetFormaz,EstrazioneIni,fine)
    aValori(3) = RetRitardo
    aValori(4) = RetRitardoMax
    aValori(5) = Freq
    Call ElencoRitardi(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
    last10 = UBound(aRetRitardi) - 10
    last = UBound(aRetRitardi)
    f1 = 0
    f = 6
    For f1 = f1 + 1 To 10
        aValori(f + f1) = aRetRitardi(last - f1)
        somrit = somrit + aRetRitardi(last - f1)
    Next
    aValori(6) = somrit
    Call AddRigaTabella(aValori,Bianco_,"center",1)
    Call SetColoreCella(6,vbYellow,vbBlue)
    Call SetColoreCella(3,vbYellow,vbBlue)
    If retRitardo >= RetRitardoMax Then
        Call SetColoreCella(3,vbRed,vbWhite)
        Call SetColoreCella(4,vbRed,vbWhite)
    End If
    GetRitardi = Lancia
End Function
 
A me funziona uso spaziometria 1.5.73
copiato quello di bergie impostando 5 numeri a caso (nessun errore)


Cattura.JPG
 
Ultima modifica:
Per Solare il listato funziona basta chè dopo averlo copiato e riformattato dai esegui , esce x 2 volte
errore basta cancellare lo spazio prima della riga nera evidenziata,fatto questo a me funge
spero di averti aiutato ciao.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 24 gennaio 2025
    Bari
    67
    35
    46
    60
    43
    Cagliari
    09
    24
    58
    03
    62
    Firenze
    52
    68
    17
    40
    80
    Genova
    58
    85
    12
    49
    52
    Milano
    87
    04
    59
    54
    52
    Napoli
    32
    90
    61
    22
    23
    Palermo
    65
    14
    17
    75
    60
    Roma
    61
    68
    64
    09
    19
    Torino
    57
    19
    08
    01
    78
    Venezia
    90
    16
    66
    18
    50
    Nazionale
    57
    56
    33
    25
    38
    Estrazione Simbolotto
    Bari
    19
    23
    25
    34
    20

Ultimi Messaggi

Indietro
Alto