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ì 22 maggio 2026
    Bari
    45
    50
    76
    01
    26
    Cagliari
    61
    42
    13
    26
    21
    Firenze
    73
    48
    07
    84
    88
    Genova
    62
    77
    10
    13
    37
    Milano
    71
    24
    74
    37
    12
    Napoli
    25
    16
    57
    50
    43
    Palermo
    66
    74
    42
    70
    18
    Roma
    14
    10
    31
    69
    04
    Torino
    81
    12
    33
    84
    22
    Venezia
    51
    58
    80
    60
    02
    Nazionale
    45
    43
    82
    44
    90
    Estrazione Simbolotto
    Milano
    39
    13
    19
    38
    25

Ultimi Messaggi

Indietro
Alto