| Ciao a tutti, sulla base di questo post ( https://lottogam.forumfree.it/?t=78870617) e del listato fornito da Cinzia (che ringrazio nuovamente!), ecco di seguito due versioni ulteriori della ricerca del Ritardo di Posizione dei Capilista di ruota. Quella che segue è la versione con output sintetico. Option Explicit
'Ritardo di Posizione capolista ruota - Cinzia27 [19.12.2021]
'Riadattato da Gam per Spaziometria
Sub Main()
Dim n(1),ru(1),LivArch
Dim Ini,Fin,q,r,es,co,a,x,rt,comax,Stringa
LivArch = 0
Scrivi " I più ritardatari su ruota (Cinzia)"
Fin = EstrazioneFin
Ini = Fin - 30
q = Int(InputBox(" Quanti ritardatari vuoi visualizzare ?",,1))
If q = "" Then Exit Sub
For r = 1 To 12
If r = 11 Then r = 12
ru(1) = r
Scrivi String(21,"*") & String(10*q,"*") & String(6,"*")
co = 0
comax = 0
For es = Ini To Fin
If ScriptInterrotto Then Exit Sub
Messaggio("Elaborazione ruota di " & SiglaRuota(r))
Call AvanzamentoElab(Ini,Fin,es)
co = co + 1
Stringa = ""
Stringa = FormattaStringa(es,"000000") & " " & DataEstrazione(es) & " " & SiglaRuota(r) & " "
For x = 1 To q
a = NumeroPosRit(es - 1,r,x,LivArch)
n(1) = a
If Posizione(es,r,a,LivArch) > 0 Then
ColoreTesto 2
Stringa = Stringa & Format2(a)
Stringa = Stringa & " RC " & FormattaStringa(RitardoEstrattoTurbo(a,es - 1,r,,,LivArch),"000") & " "
comax = co
co = 0
Else
ColoreTesto 0
rt = SerieRitardo(1,es - 1,n,ru,1,,,LivArch)
Stringa = Stringa & Format2(n(1)) & " "',,0
Stringa = Stringa & "RC " & FormattaStringa(rt + 1,"000") & " "
ColoreTesto 0
End If
ColoreTesto 0
Next
If co > 0 Then
comax = 0
If es = EstrazioneFin Then Scrivi Stringa & "RP " & FormattaStringa(co,"000") & " ***"
Else Scrivi Stringa & "RP " & FormattaStringa(comax,"000")
End If
Next
Next
Scrivi TempoTrascorso
End Sub Questa invece è con output su file di testo. Option Explicit
'Ritardo di Posizione capolista ruota - Cinzia27 [19.12.2021]
'Riadattato da Gam per Spaziometria
' NB: per funzionare si deve eseguire Spaziometria come Amministratore
Dim Fileout
Sub Main()
Dim n(1),ru(1),LivArch
Dim Ini,Fin,q,r,es,co,a,x,rt,comax,Stringa
LivArch = 0
Scrivi " I più ritardatari su ruota (Cinzia)"
Fin = EstrazioneFin
Ini = EstrazioneIni'Fin - 30
q = Int(InputBox(" Quanti ritardatari vuoi visualizzare ?",,1))
If q = "" Then Exit Sub
CreaFile("c:\RdP_dal_" & Ini & "_al_" & Fin & "_Archivio_L" & LivArch & ".txt")
For r = 1 To 12
If r = 11 Then r = 12
ru(1) = r
co = 0
comax = 0
For es = Ini To Fin
If ScriptInterrotto Then Exit Sub
Messaggio("Elaborazione ruota di " & SiglaRuota(r))
Call AvanzamentoElab(Ini,Fin,es)
co = co + 1
Stringa = ""
Stringa = FormattaStringa(es,"000000") & " " & DataEstrazione(es) & " " & SiglaRuota(r) & " "
For x = 1 To q
a = NumeroPosRit(es - 1,r,x,LivArch)
n(1) = a
If Posizione(es,r,a,LivArch) > 0 Then
Stringa = Stringa & Format2(a)
Stringa = Stringa & " RC " & FormattaStringa(RitardoEstrattoTurbo(a,es - 1,r,,,LivArch),"000") & " "
comax = co
co = 0
Else
rt = SerieRitardo(1,es - 1,n,ru,1,,,LivArch)
Stringa = Stringa & Format2(n(1)) & " "',,0
Stringa = Stringa & "RC " & FormattaStringa(rt + 1,"000") & " "
ColoreTesto 0
End If
Next
If co > 0 Then
comax = 0
If es = EstrazioneFin Then Fileout.writeline Stringa & "RP " & FormattaStringa(co,"000") & " ***"
Else fileout.writeline Stringa & "RP " & FormattaStringa(comax,"000")
End If
Next
Next
Scrivi TempoTrascorso
CreateObject("WScript.Shell").Run "notepad.exe c:\RdP_dal_" & Ini & "_al_" & Fin & "_Archivio_L" & LivArch & ".txt"
End Sub
Sub CreaFile(NomefileOut)
Dim OggFile,fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile(NomefileOut)
Set OggFile = fso.GetFile(NomefileOut)
Set Fileout = OggFile.OpenAsTextStream(2)
End Sub Saluti |
