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
    martedì 15 luglio 2025
    Bari
    60
    18
    12
    57
    28
    Cagliari
    20
    26
    81
    55
    18
    Firenze
    28
    59
    46
    83
    81
    Genova
    32
    57
    09
    41
    17
    Milano
    58
    31
    49
    38
    63
    Napoli
    36
    58
    57
    45
    59
    Palermo
    03
    05
    48
    86
    62
    Roma
    47
    18
    01
    23
    79
    Torino
    56
    34
    49
    89
    90
    Venezia
    46
    44
    52
    82
    78
    Nazionale
    16
    36
    15
    13
    60
    Estrazione Simbolotto
    Nazionale
    27
    09
    44
    18
    11

Ultimi Messaggi

Indietro
Alto