Novità

mi servirebbe questo script esportabile in excel

ppaaoolloo

Super Member >PLATINUM<
ciao
qualcuno di voi riesce cortesemente a
trasformarmi questo script di statistica
sulle decine con capogiocoin modo che
i risultati io possa estrarli in um foglio excel?


ringrazio anticipatamente chi vorrà cimentarsi
a farlo

Option Explicit
Sub Main()
Dim anum
Dim Sorte,IniStart,Ini,fin,nx,FinEnd
Dim RetRit,RetRitMax,IncrRitMax,RetFre
Dim RetEstratti00
Dim RetEstratti01
Dim RetEstratti02
Dim r,aTitoli,aRuota(01),a(09),aNumeri
anum = CInt(InputBox(" Scegli il Numero Capogioco "," 01 - 90 ",1))
Sorte = ScegliSorte
Ini = EstrazioneIni
fin = EstrazioneFin
Call Scrivi(" Statistica dal " & DataEstrazione(Ini) & " al " & DataEstrazione(fin) & " ",1,0,6)
Call Scrivi(" Totale estrazioni " &(EstrazioniRicerca),1,- 1,4)
Call Scrivi
Call Scrivi(" STATISTICA SULLE DECINE CON CAPOGIOCO ",1,1,,0,4)
Call Scrivi
IniStart = Timer
For r = 01 To 12
aRuota(01) = r
aTitoli = Array(aTitoli," Caso "," Ruota "," CG + DECINA "," Ritardo "," Ritardo Max."," I.R.S "," I.C "," Ultima Uscita "," Uscita - 01 "," Uscita - 02 "," R.P - 01 ")
Call InitTabella(aTitoli,vbGreen,,3,0)
a(01) = Format2(anum) & "." & "90.01.02.03.04.05.06.07.08.09"
a(02) = Format2(anum) & "." & "10.11.12.13.14.15.16.17.18.19"
a(03) = Format2(anum) & "." & "20.21.22.23.24.25.26.27.28.29"
a(04) = Format2(anum) & "." & "30.31.32.33.34.35.36.37.38.39"
a(05) = Format2(anum) & "." & "40.41.42.43.44.45.46.47.48.49"
a(06) = Format2(anum) & "." & "50.51.52.53.54.55.56.57.58.59"
a(07) = Format2(anum) & "." & "60.61.62.63.64.65.66.67.68.69"
a(08) = Format2(anum) & "." & "70.71.72.73.74.75.76.77.78.79"
a(09) = Format2(anum) & "." & "80.81.82.83.84.85.86.87.88.89"
For nx = 01 To 09
aNumeri = Split("00." & a(nx),".")
Call Messaggio(NomeRuota(r))
Call AvanzamentoElab(01,12,r)
Call StatisticaFormazioneTurbo(aNumeri,aRuota,Sorte,RetRit,RetRitMax,IncrRitMax,RetFre,Ini,fin)
Call VerificaEsitoTurbo(aNumeri,aRuota,EstrazioneFin - 00,01,01,,,,RetEstratti00)
Call VerificaEsitoTurbo(aNumeri,aRuota,EstrazioneFin - 01,01,01,,,,RetEstratti01)
Call VerificaEsitoTurbo(aNumeri,aRuota,EstrazioneFin - 02,01,01,,,,RetEstratti02)
ReDim rp(02)
Dim z,iniz,fine
For z = 01 To 02
iniz = EstrazioneIni
fine = EstrazioneFin
rp(z) = SerieRitardoTurbo(iniz,fine,aNumeri,aRuota,Sorte)
fine = fine -(rp(z) + 01)
Next
ReDim avalori(12)
avalori(01) = Format2(nx)
avalori(02) = NomeRuota(r)
avalori(03) = StringaNumeri(aNumeri,,True)
avalori(04) = RetRit
avalori(05) = RetRitMax
avalori(06) = IncrRitMax
avalori(07) = Round(((RetFre / EstrazioniRicerca) * RetRit),02)
avalori(08) = RetEstratti00
avalori(09) = RetEstratti01
avalori(10) = RetEstratti02
avalori(11) = rp(02)
Call AddRigaTabella(avalori,,,4,,1)
Call SetColoreCella(03,,vbBlue)
Call SetColoreCella(05,RGB(255,184,149))
Call SetColoreCella(07,RGB(255,255,128),0)
If IncrRitMax > 00 Then Call SetColoreCella(06,RGB(255,128,255))
If RetRit = 00 Then Call SetColoreCella(04,RGB(164,255,255))
If RetRit = 01 Then Call SetColoreCella(04,RGB(255,128,255))
If RetRit = 02 Then Call SetColoreCella(04,RGB(209,209,000))
If RetRit > 02 Then Call SetColoreCella(04,RGB(255,061,000))
If RetEstratti00 <> "" Then Call SetColoreCella(08,RGB(164,255,255))
If RetEstratti01 <> "" Then Call SetColoreCella(09,RGB(255,128,255))
If RetEstratti02 <> "" Then Call SetColoreCella(10,RGB(209,209,000))
Next
Call CreaTabella()
Call Scrivi
Next
FinEnd = Timer
Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((FinEnd + 01) - IniStart))
Call Scrivi
End Sub
Function ScegliSorte
ReDim aVoci(04)
aVoci(00) = "Estratto"
aVoci(01) = "Ambo"
aVoci(02) = "Terno"
aVoci(03) = "Quaterna"
aVoci(04) = "Cinquina"
ScegliSorte = ScegliOpzioneMenu(aVoci,00,"Secegli Tipo Sorte") + 01
End Function
Function FormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una stringa
' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function
 
Se non ricordo male

Dove c è la riga
Call creatabella

va modificata in

Call creatabellaordinabile

li c è la possibilità di avere un foglio Excel preparato con le colonne della tabella
 
Ciao
grazie per avermi risposto subito,
ma io non ne sono capace di fare uno script.
mi servirebbe anche se è senza il capogioco cioè solo con le decine.
aspetto fiducioso che qualcuno me lo realizzi.
grazie ancora a tutti
 
Buonanotte ,
Salutando gli intervenuti .
Abbiamo modificato il listato .

Codice:
Option Explicit
Sub Main()
   Dim anum
   Dim Sorte,IniStart,Ini,fin,Tot,nx,FinEnd
   Dim RetRit,RetRitMax,IncrRitMax,RetFre
   Dim RetEstratti00
   Dim RetEstratti01
   Dim RetEstratti02
   Dim r,aTitoli,aRuota(01),a(09),aNumeri
   anum = CInt(InputBox(" Scegli il Numero Capogioco "," 01 - 90 ",1))
   Sorte = ScegliSorte
   Ini = EstrazioneIni : fin = EstrazioneFin : Tot = EstrazioniRicerca
   Call Scrivi(" Statistica dal " & DataEstrazione(Ini) & " al " & DataEstrazione(fin) & " ",1,0,6)
   Call Scrivi(" Totale estrazioni " &(EstrazioniRicerca),1,- 1,4)
   Call Scrivi
   Call Scrivi(" STATISTICA SULLE DECINE CON CAPOGIOCO ",1,1,,0,4)
   Call Scrivi
   IniStart = Timer
   For r = 01 To 12
      aRuota(01) = r
      aTitoli = Array(aTitoli," Caso "," Ruota "," CG + DECINA "," Ritardo "," Ritardo Max."," I.R.S "," I.C "," Ultima Uscita "," Uscita - 01 "," Uscita - 02 "," R.P - 01 ")
      Call InitTabella(aTitoli,vbGreen)
      a(01) = Format2(anum) & "." & "90.01.02.03.04.05.06.07.08.09"
      a(02) = Format2(anum) & "." & "10.11.12.13.14.15.16.17.18.19"
      a(03) = Format2(anum) & "." & "20.21.22.23.24.25.26.27.28.29"
      a(04) = Format2(anum) & "." & "30.31.32.33.34.35.36.37.38.39"
      a(05) = Format2(anum) & "." & "40.41.42.43.44.45.46.47.48.49"
      a(06) = Format2(anum) & "." & "50.51.52.53.54.55.56.57.58.59"
      a(07) = Format2(anum) & "." & "60.61.62.63.64.65.66.67.68.69"
      a(08) = Format2(anum) & "." & "70.71.72.73.74.75.76.77.78.79"
      a(09) = Format2(anum) & "." & "80.81.82.83.84.85.86.87.88.89"
      For nx = 01 To 09
         aNumeri = Split("00." & a(nx),".")
         Call Messaggio(NomeRuota(r))
         Call AvanzamentoElab(01,12,r)
         Call StatisticaFormazioneTurbo(aNumeri,aRuota,Sorte,RetRit,RetRitMax,IncrRitMax,RetFre,Ini,fin)
         Call VerificaEsitoTurbo(aNumeri,aRuota,fin - 00,01,01,,,,RetEstratti00)
         Call VerificaEsitoTurbo(aNumeri,aRuota,fin - 01,01,01,,,,RetEstratti01)
         Call VerificaEsitoTurbo(aNumeri,aRuota,fin - 02,01,01,,,,RetEstratti02)
         ReDim rp(02)
         Dim z,iniz,fine
         For z = 01 To 02
            iniz = Ini :  fine = fin
            rp(z) = SerieRitardoTurbo(iniz,fine,aNumeri,aRuota,Sorte)
            fine = fine -(rp(z) + 01)
         Next
         ReDim avalori(12)
         avalori(01) = Format2(nx)
         avalori(02) = NomeRuota(r)
         avalori(03) = StringaNumeri(aNumeri,,True)
         avalori(04) = RetRit
         avalori(05) = RetRitMax
         avalori(06) = IncrRitMax
         avalori(07) = Round(((RetFre / Tot) * RetRit),02)
         avalori(08) = RetEstratti00
         avalori(09) = RetEstratti01
         avalori(10) = RetEstratti02
         avalori(11) = rp(02)
         Call AddRigaTabella(avalori)
         Call SetColoreCella(03,,vbBlue)
         Call SetColoreCella(05,RGB(255,184,149))
         Call SetColoreCella(07,RGB(255,255,128),0)
         If IncrRitMax > 00 Then Call SetColoreCella(06,RGB(255,128,255))
         If RetRit = 00 Then Call SetColoreCella(04,RGB(164,255,255))
         If RetRit = 01 Then Call SetColoreCella(04,RGB(255,128,255))
         If RetRit = 02 Then Call SetColoreCella(04,RGB(209,209,000))
         If RetRit > 02 Then Call SetColoreCella(04,RGB(255,061,000))
         If RetEstratti00 <> "" Then Call SetColoreCella(08,RGB(164,255,255))
         If RetEstratti01 <> "" Then Call SetColoreCella(09,RGB(255,128,255))
         If RetEstratti02 <> "" Then Call SetColoreCella(10,RGB(209,209,000))
      Next
      Call CreaTabellaOrdinabile()
      Call Scrivi()
   Next
   FinEnd = Timer
   Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((FinEnd + 01) - IniStart))
   Call Scrivi
End Sub
Function ScegliSorte
   ReDim aVoci(04)
   aVoci(00) = "Estratto"
   aVoci(01) = "Ambo"
   aVoci(02) = "Terno"
   aVoci(03) = "Quaterna"
   aVoci(04) = "Cinquina"
   ScegliSorte = ScegliOpzioneMenu(aVoci,00,"Secegli Tipo Sorte") + 01
End Function
Function FormattaSecondi(s)
   'Questa Function trasforma il numero di secondi passato come parametro in una stringa
   ' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
   ' s ---> Numero di secondi da formattare
   ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
   Dim hh
   Dim Mm
   Dim Ss
   Dim TimeStr
   hh = s \ 3600
   Mm =(s Mod 3600) \ 60
   Ss = s -((hh * 3600) +(Mm * 60))
   TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
   FormattaSecondi = TimeStr
End Function

Controllare Sempre .
Salvo Errori ed Omissis .
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 21 ottobre 2025
    Bari
    89
    74
    27
    47
    37
    Cagliari
    78
    13
    22
    83
    44
    Firenze
    56
    79
    68
    59
    75
    Genova
    74
    40
    71
    57
    18
    Milano
    88
    11
    33
    07
    84
    Napoli
    53
    25
    49
    83
    85
    Palermo
    49
    25
    85
    20
    11
    Roma
    14
    50
    75
    10
    13
    Torino
    43
    67
    36
    72
    73
    Venezia
    88
    55
    26
    59
    37
    Nazionale
    15
    49
    18
    21
    20
    Estrazione Simbolotto
    18
    24
    21
    32
    33

Ultimi Messaggi

Indietro
Alto