Novità

modifica

G

giorgio1960

Super Member >PLATINUM<
buonasera a tutti, è possibile modificare il seguente script, trovato nel forum, in modo da analizzare anche la sorte per ambata?

Option Explicit
Sub Main
Dim aruote,aCol,r,s,RetRit,RetRitMax,RetIncrRitMax,RetFre,min,aRetRitardi,aRetIdEstr,nrt,y,ct,tt,la,ki,yy,rae,re,j,a,e,ee,ru
Dim clsSvil,nClasseSvil
Dim i,ii,finale,nRuoteSel,leggi,u,uu,rix,rr,maxmax,maxrf
Set clsSvil = GetMotoreSviluppoIntegrale
ReDim anumeri(90),comb(2600000,2)
ScegliNumeri(anumeri)
nClasseSvil = CInt(InputBox("Sviluppo in Classe ",,10))
nRuoteSel = SelRuote(aruote)
s = CInt(InputBox("Sorte 2,3,4,5, ",,2))
min = CInt(InputBox("Ritardo Minimo richiesto..",,0))
finale = InputBox("Situazione all..estrazione n.",,EstrazioneFin)
Scrivi "Situazione aggiornata : " & finale & " / " & DataEstrazione(finale) & " |LunghetteLottoTomSky| ",1
ColoreTesto(2)
Scrivi "Numeri selezionati : " & StringaNumeri(anumeri,".") & " Sviluppati in classe " & nClasseSvil,1
Scrivi "Per la sorte..." & s & " Ritardo Minimo Richiesto...." & min,1
ColoreTesto(1)
nrt = ""
For r = 1 To nRuoteSel
Scrivi "Ruote Selezionate :" & NomeRuota(aruote(r)),1
nrt = nrt & SiglaRuota(aruote(r)) & " - "
Next
Scrivi "--------------------------------------------------------------",1
ColoreTesto(0)
Call clsSvil.InitSviluppoIntegrale(anumeri,nClasseSvil)
Do While clsSvil.GetCombSviluppo(aCol)
ii = ii + 1
Messaggio(ii & " " & i & " Rmin.." & min)
If ScriptInterrotto Then Exit Do
' Call StatisticaFormazioneTurbo(aCol,aruote,s,RetRit,RetRitMax,RetIncrRitMax,RetFre,3950,finale)
RetRit = RitardoCombinazioneTurbo(aruote,aCol,s,finale,,,3950)
If RetRit > maxmax Then
maxmax = RetRit
min = RetRit
End If
If RetRit >= Int(min) Then
i = i + 1
comb(i,1) = RetRit
comb(i,2) = StringaNumeri(aCol," ")
''''''''''''''''''''''''''''''''''''''
'' Scrivi FormattaStringa(i,"00000") & " ..... " & StringaNumeri(aCol," ") & "....Rit.." & RetRit & " / " & RetRitMax
''''''''''''''''''''''''''''''''''''''
End If
Loop
Scrivi "Totale combinazioni " & i
Scrivi "Ritardo MaxMax Tutte ............." & maxmax,1
Call OrdinaMatrice(comb,- 1,1)
''''''''''''''''''''''''''''''''''''''''''' tabella output '''''''''''''''''''''''''''''''''''''''''''''''
ReDim atitoli(13),avalori(13)
' preimposto i titoli delle colonne
atitoli(1) = " Combinazione "
atitoli(2) = " - BA - "
atitoli(3) = " - CA - "
atitoli(4) = " - FI - "
atitoli(5) = " - GE - "
atitoli(6) = " - MI - "
atitoli(7) = " - NA - "
atitoli(8) = " - PA - "
atitoli(9) = " - RO - "
atitoli(10) = " - TO - "
atitoli(11) = " - VE - "
atitoli(12) = " - TT - "
atitoli(13) = " - NZ - "
SetTableWidth("95%px")
Call InitTabella(atitoli,2,"center",1.35,5,"Cambria")
For a = 1 To 100
ReDim nm(nClasseSvil)
If Int(comb(a,1)) > 0 Then
ReDim aqx(0),nm(nClasseSvil)
Call SplitByChar(comb(a,2)," ",aqx)
avalori(1) = StringaNumeri(aqx," ")
ee = 0
For e = 0 To UBound(aqx)
ee = ee + 1
nm(ee) = aqx(e)
Next
rix = 2
ReDim arRF(1),flag(12)
For rr = 1 To 12
arRF(1) = rr
Call StatisticaFormazioneTurbo(nm,arRF,s,RetRit,RetRitMax,RetIncrRitMax,RetFre,3950,finale)
avalori(rix) = RetRit & " / " & RetRitMax
rix = rix + 1
'''calcola ritardo maxmax ruote fisse
If rr <> 11 Then
If RetRitMax > maxrf Then
maxrf = RetRitMax
End If
End If
'''prepara flag per individuare le ruote dove c'è il max
If RetRit >= RetRitMax Then
flag(rr) = 1
Else
flag(rr) = 0
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Call AddRigaTabella(avalori,Bianco_,"center",1)
Call SetColoreCella(12,RGB(255,255,168),vbBlack)
For ru = 1 To 12
If flag(ru) = 1 Then
Call SetColoreCella(1,RGB(255,255,176),vbBlack)
Call SetColoreCella(Int(ru + 1),RGB(209,209,209),vbBlack)
End If
Next
' Scrivi comb(a,1) & "............" & StringaNumeri(comb(a,2),".")
End If
Next
Scrivi "Ritardo MaxMax Ruote Fisse......." & maxrf,1
Call CreaTabella(12,- 1,,500)
End Sub
Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function

anticipatamente ringrazio Giorgio
 
giorgio1960;n2175621 ha scritto:
buonasera a tutti, è possibile modificare il seguente script, trovato nel forum, in modo da analizzare anche la sorte per ambata?

anticipatamente ringrazio Giorgio
Clicca per espandere...

Ciao Giorgio, lo script che hai postato è pieno di errori (per lo più dovuti a spazi eccessivi riportati nel tuo copia e incolla del codice stesso).

Ad ogni modo, una volta ricostruito... e reso operativo, la modifica da apportare, per farlo diventare anche teoricamente utile per l'analisi statistica di ambata sulla ruota o ruote desiderate, è semplicemente questa:

Codice: 
  nClasseSvil = CInt(InputBox("Sviluppo in Classe ",,2))

Codice: 
 s = CInt(InputBox("Sorte 1,2,3,4,5, ",,1))


Sotto ti riporto lo script "riparato" e funzionante... con la modifica per ambata che hai richiesto. Ciao


Codice: 
Option Explicit
Sub Main
Dim aruote,aCol,r,s,RetRit,RetRitMax,RetIncrRitMax,RetFre,min,aRetRitardi,aRetIdEstr,nrt,y,ct,tt,la,ki,yy,rae,re,j,a,e,ee,ru
'Dim RetRit
'Dim maxmax
'Dim aruote
'Dim aCol
'Dim s
'Dim finale
'Dim reritmax
Dim clsSvil,nClasseSvil
Dim i,ii,finale,nRuoteSel,leggi,u,uu,rix,rr,maxmax,maxrf
Set clsSvil = GetMotoreSviluppoIntegrale
ReDim anumeri(90),comb(2600000,2)
ScegliNumeri(anumeri)
nClasseSvil = CInt(InputBox("Sviluppo in Classe ",,2))
nRuoteSel = SelRuote(aruote)
s = CInt(InputBox("Sorte 1,2,3,4,5, ",,1))
min = CInt(InputBox("Ritardo Minimo richiesto..",,0))
finale = InputBox("Situazione all..estrazione n.",,EstrazioneFin)
Scrivi "Situazione aggiornata : " & finale & " / " & DataEstrazione(finale) & " |LunghetteLottoTomSky| ",1
ColoreTesto(2)
Scrivi "Numeri selezionati : " & StringaNumeri(anumeri,".") & " Sviluppati in classe " & nClasseSvil,1
Scrivi "Per la sorte..." & s & " Ritardo Minimo Richiesto...." & min,1
ColoreTesto(1)
nrt = ""
For r = 1 To nRuoteSel
Scrivi "Ruote Selezionate :" & NomeRuota(aruote(r)),1
nrt = nrt & SiglaRuota(aruote(r)) & " - "
Next
Scrivi "--------------------------------------------------------------",1
ColoreTesto(0)
Call clsSvil.InitSviluppoIntegrale(anumeri,nClasseSvil)
Do While clsSvil.GetCombSviluppo(aCol)
ii = ii + 1
Messaggio(ii & " " & i & " Rmin.." & min)
If ScriptInterrotto Then Exit Do
' Call StatisticaFormazioneTurbo(aCol,aruote,s,RetRit,Ret RitMax,RetIncrRitMax,RetFre,3950,finale)
RetRit = RitardoCombinazioneTurbo(aruote,aCol,s,finale,,,3950)
If(RetRit > maxmax) Then
maxmax = RetRit
min = RetRit
End If
If RetRit >= Int(min) Then
i = i + 1
comb(i,1) = RetRit
comb(i,2) = StringaNumeri(aCol," ")
''''''''''''''''''''''''''''''''''''''
'' Scrivi FormattaStringa(i,"00000") & " ..... " & StringaNumeri(aCol," ") & "....Rit.." & RetRit & " / " & RetRitMax
''''''''''''''''''''''''''''''''''''''
End If
Loop
Scrivi "Totale combinazioni " & i
Scrivi "Ritardo MaxMax Tutte ............." & maxmax,1
Call OrdinaMatrice(comb,- 1,1)
''''''''''''''''''''''''''''''''''''''''''' tabella output '''''''''''''''''''''''''''''''''''''''''''''''
ReDim atitoli(13),avalori(13)
' preimposto i titoli delle colonne
atitoli(1) = " Combinazione "
atitoli(2) = " - BA - "
atitoli(3) = " - CA - "
atitoli(4) = " - FI - "
atitoli(5) = " - GE - "
atitoli(6) = " - MI - "
atitoli(7) = " - NA - "
atitoli(8) = " - PA - "
atitoli(9) = " - RO - "
atitoli(10) = " - TO - "
atitoli(11) = " - VE - "
atitoli(12) = " - TT - "
atitoli(13) = " - NZ - "
SetTableWidth("95%px")
Call InitTabella(atitoli,2,"center",1.35,5,"Cambria")
For a = 1 To 100
ReDim nm(nClasseSvil)
If Int(comb(a,1)) > 0 Then
ReDim aqx(0),nm(nClasseSvil)
Call SplitByChar(comb(a,2)," ",aqx)
avalori(1) = StringaNumeri(aqx," ")
ee = 0
For e = 0 To UBound(aqx)
ee = ee + 1
nm(ee) = aqx(e)
Next
rix = 2
ReDim arRF(1),flag(12)
For rr = 1 To 12
arRF(1) = rr
Call StatisticaFormazioneTurbo(nm,arRF,s,RetRit,RetRitMax,RetIncrRitMax,RetFre,3950,finale)
avalori(rix) = RetRit & " / " & RetRitMax
rix = rix + 1
'''calcola ritardo maxmax ruote fisse
If rr <> 11 Then
If RetRitMax > maxrf Then
maxrf = RetRitMax
End If
End If
'''prepara flag per individuare le ruote dove c'è il max
If RetRit >= RetRitMax Then
flag(rr) = 1
Else
flag(rr) = 0
End If
Next
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''
Call AddRigaTabella(avalori,Bianco_,"center",1)
Call SetColoreCella(12,RGB(255,255,168),vbBlack)
For ru = 1 To 12
If flag(ru) = 1 Then
Call SetColoreCella(1,RGB(255,255,176),vbBlack)
Call SetColoreCella(Int(ru + 1),RGB(209,209,209),vbBlack)
End If
Next
' Scrivi comb(a,1) & "............" & StringaNumeri(comb(a,2),".")
End If
Next
Scrivi "Ritardo MaxMax Ruote Fisse......." & maxrf,1
Call CreaTabella(12,- 1,,500)
End Sub
Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function
 
Ultima modifica:
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 16 giugno 2026
    Bari
    50
    42
    62
    52
    07
    Cagliari
    41
    18
    67
    64
    79
    Firenze
    64
    10
    21
    20
    84
    Genova
    15
    12
    37
    74
    08
    Milano
    10
    44
    88
    20
    58
    Napoli
    34
    15
    47
    23
    60
    Palermo
    36
    44
    51
    03
    84
    Roma
    61
    16
    29
    26
    63
    Torino
    40
    70
    06
    73
    01
    Venezia
    18
    19
    17
    44
    27
    Nazionale
    26
    79
    22
    04
    90
    Estrazione Simbolotto
    Napoli
    11
    06
    05
    34
    28
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto