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
    sabato 18 ottobre 2025
    Bari
    23
    03
    54
    34
    30
    Cagliari
    49
    14
    25
    09
    37
    Firenze
    32
    45
    15
    59
    29
    Genova
    03
    66
    68
    90
    85
    Milano
    88
    15
    21
    41
    27
    Napoli
    79
    72
    84
    27
    01
    Palermo
    23
    03
    73
    25
    04
    Roma
    11
    67
    24
    13
    59
    Torino
    72
    59
    84
    75
    26
    Venezia
    81
    08
    18
    76
    25
    Nazionale
    58
    69
    62
    17
    70
    Estrazione Simbolotto
    08
    26
    28
    22
    40
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto