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ì 14 gennaio 2025
    Bari
    41
    25
    12
    73
    55
    Cagliari
    54
    20
    48
    32
    67
    Firenze
    75
    23
    68
    10
    38
    Genova
    33
    27
    81
    70
    64
    Milano
    68
    01
    64
    86
    87
    Napoli
    47
    75
    45
    10
    21
    Palermo
    55
    86
    33
    53
    70
    Roma
    88
    78
    61
    06
    07
    Torino
    76
    08
    23
    61
    82
    Venezia
    25
    15
    49
    21
    81
    Nazionale
    70
    10
    32
    78
    07
    Estrazione Simbolotto
    Bari
    07
    14
    28
    45
    31
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto