mi servirebbe questo script esportabile in excel

ppaaoolloo · 28 Aprile 2019

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

Rubino · 28 Aprile 2019

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

ppaaoolloo · 28 Aprile 2019

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

Membro cancellato 16574 · 2 Maggio 2019

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 .

Cerca

Cerca

mi servirebbe questo script esportabile in excel

ppaaoolloo

Super Member >PLATINUM<

Rubino

Guest

ppaaoolloo

Super Member >PLATINUM<

Membro cancellato 16574

Guest

Ultima estrazione Lotto

Ultimi Messaggi