Novità

modifica

G

giorgio1960

Super Member >GOLD<
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ì 09 settembre 2025
    Bari
    80
    40
    25
    05
    49
    Cagliari
    88
    51
    28
    38
    67
    Firenze
    83
    86
    78
    03
    77
    Genova
    29
    67
    66
    25
    63
    Milano
    85
    66
    63
    75
    60
    Napoli
    78
    60
    75
    41
    69
    Palermo
    49
    50
    88
    34
    19
    Roma
    40
    47
    61
    57
    09
    Torino
    20
    86
    42
    53
    28
    Venezia
    33
    60
    83
    75
    14
    Nazionale
    87
    81
    08
    22
    78
    Estrazione Simbolotto
    Palermo
    42
    33
    44
    16
    36
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto