vincenzo4221
Advanced Member >PLATINUM<
Ciao a tutti e buon rientro....chi ci aiuta per trasformare lo script allegato per trovare i rapporti attuali? preciso che lo script è avanzatissimo infatti non trova solo le normali formazioni, ma anche quelle formazioni con un passo diverso da 0 (cioe, non solo formazioni di numeri sincroni continui in verticale, ma anche quelli cadenzati da un estrazione o due senza numeri).
'RSL verticale rapporti storico:
Sub Main()
Dim nu1(90)
Dim ru(1)
ru(1) = InputBox("Inserisci la Ruota",,6)
pos = InputBox("Inserisci la posizione",,4)
pa = InputBox("Passo di ricerca?",,1)
ruo = ru(1)
ini = EstrazioneIni
fin = EstrazioneFin
ColoreTesto(2)
Scrivi FormatSpace("Elaborazione svolta sulla ruota di:",36) & FormatSpace(NomeRuota(ruo),8),True
Scrivi FormatSpace("Posizione:",38) & FormatSpace(pos,15),True
Scrivi FormatSpace("Passo di ricerca:",38) & FormatSpace(pa,15),True
ColoreTesto(1)
Scrivi String(120,247),True
Scrivi FormatSpace("Formazione",27) & FormatSpace("Ritardo",15) & FormatSpace("RSL",14) & FormatSpace("RSL/RC",17) & FormatSpace("Formata In",16) & FormatSpace("Sortita In",15),True
Scrivi Space(39) & FormatSpace("Raggiunto",17) & FormatSpace("Storico",21) & FormatSpace("Data",15) & FormatSpace("Data",10),True
Scrivi String(120,247),True
For x = ini To fin
AvanzamentoElab ini,fin,x
GeneraAnalitico x
For rit = 1 To TabelloneAnalitico(0,0,0) + 1
If TabelloneAnalitico(rit - 1,ruo,pos) = 0 Then
If TabelloneAnalitico(rit,ruo,pos) > 0 Then
k = k + 1
nu1(k) = TabelloneAnalitico(rit,ruo,pos)
rit2 = rit
Do
For pp = 1 To pa
If TabelloneAnalitico(rit2 + pp,ruo,pos) = 0 Then
rco = 1
Else
rco = 0
Exit For
End If
Next
If rco = 1 And TabelloneAnalitico(rit2 + pa + 1,ruo,pos) > 0 And TabelloneAnalitico(rit2 + pa + 2,ruo,pos) = 0 Then
k = k + 1
nu1(k) = TabelloneAnalitico(rit2 + pa + 1,ruo,pos)
rit2 = rit2 + pa + 1
Else
Exit Do
End If
Loop
End If
End If
If k >= 2 Then
ds = SeriePrima(x,fin,nu1,ru,1,0)
rr = SerieRitardo(ini,ds - 1,nu1,ru,1)
rsl = ds - x - 1
If rr > 0 Then rap = rsl/rr
If rsl <> 0 And rr <> 0 And rap > rm Then
Scrivi FormatSpace(StringaNumeri(nu1),30) & FormatSpace(rr,13) & FormatSpace(rsl,14) & _
FormatNumber(rap,3) & " " & FormatSpace(DataEstrazione(x),15) & _
FormatSpace(DataEstrazione(ds),10)
rm = rap
End If
rco = 0 : rit = rit2
End If
Erase nu1 : K = 0
Next
Next
End Sub
'RSL verticale rapporti storico:
Sub Main()
Dim nu1(90)
Dim ru(1)
ru(1) = InputBox("Inserisci la Ruota",,6)
pos = InputBox("Inserisci la posizione",,4)
pa = InputBox("Passo di ricerca?",,1)
ruo = ru(1)
ini = EstrazioneIni
fin = EstrazioneFin
ColoreTesto(2)
Scrivi FormatSpace("Elaborazione svolta sulla ruota di:",36) & FormatSpace(NomeRuota(ruo),8),True
Scrivi FormatSpace("Posizione:",38) & FormatSpace(pos,15),True
Scrivi FormatSpace("Passo di ricerca:",38) & FormatSpace(pa,15),True
ColoreTesto(1)
Scrivi String(120,247),True
Scrivi FormatSpace("Formazione",27) & FormatSpace("Ritardo",15) & FormatSpace("RSL",14) & FormatSpace("RSL/RC",17) & FormatSpace("Formata In",16) & FormatSpace("Sortita In",15),True
Scrivi Space(39) & FormatSpace("Raggiunto",17) & FormatSpace("Storico",21) & FormatSpace("Data",15) & FormatSpace("Data",10),True
Scrivi String(120,247),True
For x = ini To fin
AvanzamentoElab ini,fin,x
GeneraAnalitico x
For rit = 1 To TabelloneAnalitico(0,0,0) + 1
If TabelloneAnalitico(rit - 1,ruo,pos) = 0 Then
If TabelloneAnalitico(rit,ruo,pos) > 0 Then
k = k + 1
nu1(k) = TabelloneAnalitico(rit,ruo,pos)
rit2 = rit
Do
For pp = 1 To pa
If TabelloneAnalitico(rit2 + pp,ruo,pos) = 0 Then
rco = 1
Else
rco = 0
Exit For
End If
Next
If rco = 1 And TabelloneAnalitico(rit2 + pa + 1,ruo,pos) > 0 And TabelloneAnalitico(rit2 + pa + 2,ruo,pos) = 0 Then
k = k + 1
nu1(k) = TabelloneAnalitico(rit2 + pa + 1,ruo,pos)
rit2 = rit2 + pa + 1
Else
Exit Do
End If
Loop
End If
End If
If k >= 2 Then
ds = SeriePrima(x,fin,nu1,ru,1,0)
rr = SerieRitardo(ini,ds - 1,nu1,ru,1)
rsl = ds - x - 1
If rr > 0 Then rap = rsl/rr
If rsl <> 0 And rr <> 0 And rap > rm Then
Scrivi FormatSpace(StringaNumeri(nu1),30) & FormatSpace(rr,13) & FormatSpace(rsl,14) & _
FormatNumber(rap,3) & " " & FormatSpace(DataEstrazione(x),15) & _
FormatSpace(DataEstrazione(ds),10)
rm = rap
End If
rco = 0 : rit = rit2
End If
Erase nu1 : K = 0
Next
Next
End Sub