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ì 13 ottobre 2026
    Bari
    56
    21
    79
    19
    67
    Cagliari
    23
    76
    52
    15
    63
    Firenze
    22
    63
    81
    76
    49
    Genova
    17
    57
    79
    14
    68
    Milano
    01
    03
    46
    32
    29
    Napoli
    69
    23
    30
    80
    10
    Palermo
    76
    84
    49
    87
    82
    Roma
    20
    06
    36
    62
    18
    Torino
    41
    55
    33
    08
    87
    Venezia
    39
    06
    81
    41
    79
    Nazionale
    52
    33
    59
    45
    12
    Estrazione Simbolotto
    37
    33
    13
    19
    08
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto