Novità

Quesito

  • Creatore Discussione Creatore Discussione palas
  • Data di inizio Data di inizio
ciao come ti avevo detto mancavano de parametri alla funzione che avevi individuato anche tu ..l'ho corretta
e poi evita di usare i : per gli script da compilare

Codice: 
Option Explicit
Sub Main
   '''''Beppignello
   Dim n,r,fine,ini,rit,max,y,ct,qt,retestratti,retidestr,v,des,b,j,retesito,aretritardi,aretidestr
   Dim Forzatot,presrea,teopres,teobrev,molla10c,cqt,ctb,rsl,anm,RS,rslSINGLE,nretliv,ixp,nconc
   Dim ar(1),an(1),esi(5)
   fine = InputBox("fino Estraz.n.",,EstrazioneFin)
   r = InputBox("Verifica Ruota ",,1)
   rit = InputBox("RT scelto ",,31)
   nconc = CInt(InputBox("N.Estraz.",,13))
   ini = 3950 ''' inizio venus e nz
   ''
   teopres = Int((fine - 3950)/18 + 0.99)
   teobrev = 10
   '''
   Scrivi
   Scrivi "Bep-LottoQuantitativo-Tabelloni    " & "    **************     1° Quadro statistico  ROOKIE/Buchi e Presenze a RT(x)   *************** ",1,2,4
   Scrivi "Situazione dalla estr.n.7440 ad oggi dei Numeri a Livello (1)  della cinquina estratta ",1
   Scrivi "Verifica esiti e creazione Vuoto nella sequenza Ritardi ",1
   Scrivi
   ''''''
   '''situazione buchi nell'estrazione
   Call buchivuoti(fine,rit,ini)
   '''''''''''''''''''''''''''''''''''
   Scrivi
   Scrivi "Bep-LottoQuantitativo-Tabelloni    " & "    **************     2° Quadro statistico  Urne TT e Presenze =  0  *************** ",1,2,4
   Call urne(fine,nconc)
   '''''''''''''''''''''''''
   Scrivi "Tempo Elab. " & TempoTrascorso,1
End Sub
Function buchivuoti(fine,rit,Ini)
   Dim nub,ritab,rub,yb,lista,cqt,ru,w,z,ctb,retrit,retritmax,listavert,vqt,retfre,ct,ruo,nc,ELE,P,AA,BB,teos,teob,frebre,yy,v,xx,j,j1,j2,so,qq
   Dim fre,teo,desc,dif,listaup,rs,Totrs,an,nretliv,fmedio72,Totl1,tgv,tv,listateo,RC,rsL,IXP,freLUN,ARETRITARDI,ARETIDESTR,listaverRsl
   ReDim riga(35),ar(1)
   ColoreTesto(1)
   Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,2,4
   Scrivi "TURT RT Vuoti nella Ruota(X)  sono calcolati da RT>4 AND RT<35 ",1,2,4
   Scrivi "Dove compara (X) significa che non c'è presente nessun L5:L1 cioè è BucoVuoto ",1,2,4
   Scrivi "In Verticale (BP) e Qt.Buchi Con Misto Numeri da L5:L1  nelle 10 Ruote",1,2,4
   Scrivi "Ru- -Qt--> Rt | 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34| Teo Dif |",1
   ColoreTesto(0)
   ''''''loop per 10 ruote
   ReDim glo(10,300,3),Verti(35)
   For rub = 1 To 10
      lista = "" : ctb = 0
      '''calcola valori rt come tabellone ritardi di ogni ruota
      ReDim rcb(300,3)
      For nub = 1 To 90
         ritab = EstrattoRitardoTurbo(rub,nub,fine - 500,fine)
         rcb(ritab,1) = FormattaStringa(ritab,"000")
         rcb(ritab,2) = rcb(ritab,2) & Format2(nub) & "."
         rcb(ritab,3) = rcb(ritab,3) + 1
         ''
         glo(rub,ritab,1) = FormattaStringa(ritab,"000")
         glo(rub,ritab,2) = glo(rub,ritab,2) & Format2(nub) & "."
         glo(rub,ritab,3) = glo(rub,ritab,3) + 1
      Next
      ''''cerca rt = 0 corrisponde a buco vuoto(senza numeri)  nel ritardo
      For yb = 5 To 34
         If yb > 4 And yb < 35 Then
            If Int(rcb(yb,1)) < 1 And yb > 4 And yb < 35 Then
               riga(yb) = " X |"
               lista = lista & " X |"
               ctb = ctb + 1
               Verti(yb) = Verti(yb) + 1
            Else
               If yb = 5 Then
                  riga(yb) = "|   |"
                  lista = "   |   |"
               Else
                  riga(yb) = "    "
                  lista = lista & "   |"
               End If
            End If
         End If
      Next
      ColoreTesto(0)
      Scrivi SiglaRuota(rub) & "   " & Format2(ctb) & "    " & lista,1
      ColoreTesto(0)
   Next
   ColoreTesto(0)
   ''''accumula quanti numeri L1 per situazione - Verticale
   listavert = "Vuoti         |"
   For yb = 5 To 34
      If Verti(yb) <> "" Or Verti(yb) <> 0 Then
         listavert = listavert & " " & Format2(Verti(yb)) & "|"
      Else
         listavert = listavert & " BP|"
      End If
   Next
   Scrivi listavert
   Scrivi
   ReDim riga(35),Verti(35),verrsl(35)
   ColoreTesto(1)
   Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,3,4
   Scrivi "Quantità Ultima Estrazione di Numeri L1 presenti ai vari Rt ",1,2,4
   ColoreTesto(1)
   Scrivi "Ru- -QO-RtL1->| 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34| RE /Rx TRsl | Teo Dif |",1
   ColoreTesto(0)
   For rub = 1 To 10
      lista = "   | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
      ar(1) = rub
      ReDim nr(18)
      ''''conta tutti gli L1 x tutti gli RT
      For yb = 1 To 300
         If glo(rub,yb,3) = 1 Then
            Totl1 = Totl1 + 1
            tgv = tgv + 1
         End If
      Next
      ''''cerca L1 x RT
      For yb = 5 To 34
         If glo(rub,yb,3) <> 1 Then
            lista = lista & "  | "
         End If
         If glo(rub,yb,3) = 1 Then
            cqt = cqt + 1
            tv = tv + 1
            lista = lista & Left(glo(rub,yb,2),2) & "| "
            nr(cqt) = Left(glo(rub,yb,2),2)
            Verti(yb) = Verti(yb) + 1
            ''''calcola somma rsl di ogni numero L1 attuale
            '''calcola rsl e somma e vede max
            an = Int(nr(cqt))
            rs = RitSincDiLiv(an,ar,fine,nretliv)
            Totrs = Totrs + rs
            verrsl(yb) = verrsl(yb) + rs
         End If
      Next
      ''''calcola ritardo per estratto e massimo ritardo della comb.intera dei numeri L1  - Orizzontali
      Call StatisticaFormazioneTurbo(nr,ar,1,retrit,retritmax,0 , 0,Ini,fine)
      lista = lista & Format2(retrit) & "  " & Format2(retritmax) & "  " & FormattaStringa(Totrs,"000") & " | "
      '''calcola pres.teoriche e dif
      teo = 90*((17/18)^retrit) /3
      dif = Totl1 - teo
      ColoreTesto(0)
      If dif < 0 Then
         dif = 0 - dif
      End If
      If dif >= 0 Then
         Scrivi SiglaRuota(rub) & "   " & Format2(cqt) & "  " & Format2(Totl1) & lista & " " & FormatSpace(Format2(teo),4) & Format2(dif) & " | ",1
      End If
      ColoreTesto(0)
   Next
   Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
   ColoreTesto(0)
   ''''accumula quanti numeri L1 per situazione - Verticale
   listateo = "" :listaverRsl = ""
   listavert = "T.QV " & tv & " " & tgv & "   |"
   For yb = 5 To 34
      If Verti(yb) <> "" Or Verti(yb) <> 0 Then
         listaverRsl = listaverRsl & FormattaStringa(verrsl(yb)," 00") & "|"
         listavert = listavert & " " & Format2(Verti(yb)) & "|"
         listateo = listateo & " " & Format2((45*((85/90)^yb) + .99)) & "|"
      Else
         listavert = listavert & "  0|"
         listateo = listateo & "  0|"
         listaverRsl = listaverRsl & "  0|"
      End If
   Next
   Scrivi listavert
   listavert = "Teo RtV       |" & listateo
   Scrivi listavert
   Scrivi "TverRsl       |" & listaverRsl
   '''
   '''''''calcola numeri verticali per RT trova presenze teorica e frequenza globale e stabilisce se Trend Up o Trend Down
   ''''Rileggi e crea matrice verticale
   ''''cerca solo L1 x RT
   Scrivi
   Scrivi
   ReDim numeri(10),ruote(10)
   For yb = 5 To 34
      ReDim nr(10),ar(10),aru(1)
      vqt = 0:Totrs = 0
      listaup = "   |"
      For rub = 1 To 10
         If glo(rub,yb,3) = 1 Then
            vqt = vqt + 1
            nr(vqt) = Left(glo(rub,yb,2),2)
            ar(vqt) = rub
            '''calcola somma rs
            an = Int(nr(vqt))
            aru(1) = rub
            rs = RitSincDiLiv(an,aru,fine,nretliv)
            Totrs = Totrs + rs
            If yb = Int(rit) Then
               ct = ct + 1
               numeri(ct) = an
               ruote(ct) = rub
            End If
         End If
      Next
   Next
   Scrivi "SITUAZIONE Verticali a RT = " & rit,1,2,4
   Scrivi "Numeri    " & StringaNumeri(numeri,"."),1,2,4
   Scrivi "Ruote     " & StringaNumeri(ruote,"."),1,2,4
   Scrivi
   nc = fine - rit
   Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,3,4
   ''''''''tabella riepilogativa dei numeri e ruote richiesti
   Scrivi "Ruo  Nr.  -- ESTRATTI --     Rc.  Rsl  --%--   Liv  FreS. FreTeoS - FreB. FreTeoB ",1
   For ruo = 1 To 10
      ELE = ""
      Messaggio(ruo)
      If ruote(ruo) > 0 Then
         ReDim MatriceEstrRitorno(5)
         Call GetArrayNumeriRuota(nc,ruote(ruo),MatriceEstrRitorno)
         For P = 1 To 5
            If MatriceEstrRitorno(P) = numeri(ruo) Then
               ELE = ELE & Format2(numeri(ruo)) & "."
            Else
               ELE = ELE & "--."
            End If
         Next
         RC = EstrattoRitardoTurbo(ruote(ruo),numeri(ruo),3950,fine)
         rsL = RitSincDiLiv(numeri(ruo),ruote(ruo),fine,nretliv)
         IXP = Round(rsL/RC,3)
         AA = ruote(ruo) : BB = numeri(ruo)
         freLUN = EstrattoFrequenzaTurbo(AA,BB,3950,fine)
         frebre = EstrattoFrequenzaTurbo(AA,BB,fine - 72,fine)
         teos = Int((fine - 3950)/18 + .99)
         teob = Int((fine -(fine - 72))/18 + .99)
         Scrivi FormatSpace(SiglaRuota(ruote(ruo)),5) & FormatSpace(numeri(ruo),5) & FormatSpace(ELE,19) & FormatSpace(Format2(RC),5) & FormatSpace(Format2(rsL),5) & FormatSpace(IXP,9) & FormatSpace(nretliv,5) & FormatSpace(freLUN,8) & FormatSpace(teos,10) & FormatSpace(frebre,8) & FormatSpace(teob,5)
      End If
   Next
   ''''''''''''
   '''''ricerca nelle lunghette orizzontali le coppie di numeri di figura 9
   ''''''''''''''
   Scrivi
   Scrivi "Ricerca Coppie di estratti di Figura 9 per tentare Estratto ed ambo",1,2,4
   ColoreTesto(1)
   Scrivi "Ru- -QO-RtL1->| 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34|",1
   ColoreTesto(0)
   For rub = 1 To 10
      lista = "   | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
      ar(1) = rub
      ReDim nr(18)
      ''''conta tutti gli L1 x tutti gli RT
      For yb = 1 To 300
         If glo(rub,yb,3) = 1 Then
            Totl1 = Totl1 + 1
            tgv = tgv + 1
         End If
      Next
      ''''cerca L1 x RT
      ReDim num(34)
      For yb = 5 To 34
         If glo(rub,yb,3) <> 1 Then
            lista = lista & "  | "
         End If
         If glo(rub,yb,3) = 1 Then
            ''''''''''''''''''''''''
            cqt = cqt + 1
            tv = tv + 1
            lista = lista & Left(glo(rub,yb,2),2) & "| "
            nr(cqt) = Left(glo(rub,yb,2),2)
            Verti(yb) = Verti(yb) + 1
            ''''calcola somma rsl di ogni numero L1 attuale
            '''calcola rsl e somma e vede max
            an = Int(nr(cqt))
            rs = RitSincDiLiv(an,ar,fine,nretliv)
            Totrs = Totrs + rs
         End If
      Next
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''verifica se c'è coppia o piu estratti con figura 9
      yy = 4 : lista = "   | "
      For v = 5 To 34
         If glo(rub,v,3) = 1 Then
            xx = Left(glo(rub,v,2),2)
            If xx > 0 And Figura(xx) = 9 Then
               yy = yy + 1
               num(yy) = xx
               lista = lista & num(yy) & "| "
            Else
               lista = lista & "  | "
            End If
         Else
            lista = lista & "  | "
         End If
      Next
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''calcola pres.teoriche e dif
      teo = 90*((17/18)^retrit) /3
      dif = Totl1 - teo
      ColoreTesto(0)
      If dif < 0 Then
         dif = 0 - dif
      End If
      If dif >= 0 Then
      Scrivi SiglaRuota(rub) & "   " & Format2(cqt) & "  " & Format2(Totl1) & lista,1
      End If
      ColoreTesto(0)
   Next
   Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
   ''''''''''''
   '''''ricerca nelle lunghette orizzontali le coppie di numeri di figura 9
   ''''''''''''''
   Scrivi:Scrivi "Ricerca Coppie Simmetriche di estratti di somma 90 e 91 per tentare Estratto ed ambo",1,2,4
   ColoreTesto(1)
   Scrivi "Ru- -QO-RtL1->| Coppie di Somma     | 01-02-03-04-05-06-07-08-09-10-11-12-13-14-15-16-17-18-19-20-21-22-23-24-25-26-27-28-29-30 ",1
   ColoreTesto(0)
   For rub = 1 To 10
      lista = "   | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
      ar(1) = rub
      ReDim nr(18)
      ''''conta tutti gli L1 x tutti gli RT
      For yb = 1 To 300
         If glo(rub,yb,3) = 1 Then
            Totl1 = Totl1 + 1
            tgv = tgv + 1
         End If
      Next
      ''''cerca L1 x RT
      ReDim num(34)
      For yb = 5 To 34
         If glo(rub,yb,3) <> 1 Then
            lista = lista & "  | "
         End If
         If glo(rub,yb,3) = 1 Then
            ''''''''''''''''''''''''
            cqt = cqt + 1
            tv = tv + 1
            lista = lista & Left(glo(rub,yb,2),2) & "| "
            nr(cqt) = Left(glo(rub,yb,2),2)
            Verti(yb) = Verti(yb) + 1
            ''''calcola somma rsl di ogni numero L1 attuale
            '''calcola rsl e somma e vede max
            an = Int(nr(cqt))
            rs = RitSincDiLiv(an,ar,fine,nretliv)
            Totrs = Totrs + rs
         End If
      Next
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''verifica se c'è coppia o piu estratti con somma 90 o 91
      yy = 4 : lista = "   | " :yy = 0
      For v = 5 To 34
         If glo(rub,v,3) = 1 Then
            xx = Left(glo(rub,v,2),2)
            If xx > 0 Then
               yy = yy + 1
               num(yy) = xx
            End If
         End If
      Next
      qq = 0
      For j1 = 1 To yy - 1
         For j2 = j1 + 1 To yy
            so = Int(num(j1)) + Int(num(j2))
            If Fuori90(so) = 90 Or Fuori90(so) = 91 Then
               lista = lista & "Somma " & so & GetTestoHtml("   Nr." & num(j1) & " " & Format2(num(j2)),True,vbBlue) & " | "
               qq = 1
            End If
         Next
      Next
      If qq = 0 Then lista = lista & "                    | "
      lista = lista & StringaNumeri(num,"-")
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '''calcola pres.teoriche e dif
      teo = 90*((17/18)^retrit) /3
      dif = Totl1 - teo
      ColoreTesto(0)
      If dif < 0 Then
         dif = 0 - dif
      End If
      If dif >= 0 Then
      Scrivi SiglaRuota(rub) & "   " & Format2(cqt) & "  " & Format2(Totl1) & lista,1
      End If
      ColoreTesto(0)
   Next
   Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function urne(fine,nconc)
   Dim fr,g,hh,elenco2,Ini,Iniz,MatriceEstrRitorno,r,y,n,ctr,jj,m,nn,v,retestratti,retidestr,z,rc
   ReDim tutte(90,2),elenco2(150,3),very(90),ar(10)
   ColoreTesto(0)
   Scrivi
   Scrivi "Distribuzione con metodica Urne *** T U T T E ***  ",1,5,4
   Scrivi "Lunghezza Complessiva del Ciclo Richiesto " & nconc,1,2,4
   Ini = fine - nconc
   Iniz = fine - nconc
   ReDim nm(90,2)
   For Ini = Ini + 1 To fine
      Messaggio(Ini)
      Call GetEstrazioneCompleta(Ini,MatriceEstrRitorno)
      For r = 1 To 10
         For y = 1 To 5
            n = Format2(MatriceEstrRitorno(r,y))
            nm(n,2) = Format2(n)
            nm(n,1) = nm(n,1) + 1
         Next
      Next
      '''''controlla se usciti tutti i 90nr
      ctr = 0
      For jj = 1 To 90
         If nm(jj,1) > 0 Then
            ctr = ctr + 1
         End If
      Next
      '''
      If ctr = 90 Then
         Scrivi "Ciclo Durata " & Format2(Ini - Iniz) & " Estraz.   Inizio " & Iniz + 1 & " :  fine  " & Ini,1
         Iniz = Ini
         ReDim nm(90,2)
      End If
   Next
   ''''ciclo attuale in corso
   '''''
   ColoreTesto(2)
   Scrivi
   Scrivi "Ciclo In Corso Durata " & Format2(fine - Iniz) & " Estraz.    Inizio " & Iniz + 1 & " :  fine  " & Ini - 1,1
   ColoreTesto(0)
   ''''conta per presenze quantità di estratti
   ''m=presenze
   For m = 0 To 15
      ReDim cp(15,2)
      For nn = 1 To 90
         If nm(nn,1) > 0 And nm(nn,1) = m Then
            cp(m,1) = cp(m,1) + 1
            cp(m,2) = cp(m,2) & Format2(nm(nn,2)) & "."
            '''''mette in arrays x verifica esiti lunghetta con presenze 0,1,2
            If m < 1 Then
               v = v + 1
               very(v) = Format2(nn)
            End If
         End If
         If nm(nn,1) = 0 And nm(nn,1) = m Then
            cp(m,1) = cp(m,1) + 1
            cp(m,2) = cp(m,2) & Format2(nn) & "."
            v = v + 1
            very(v) = Format2(nn)
         End If
      Next
      If cp(m,1) > 0 Then
      Scrivi "Pr. " & Format2(m) & "  Qt." & Format2(cp(m,1)) & "  Estratti...... " & cp(m,2)
      End If
   Next
   '''''''''verifica esiti lunghetta composta dai nr. con presenze 0,1,2
   If v > 2 Then
      ar(1) = 11
      Scrivi
      Scrivi "Combinazione da verificare " & StringaNumeri(very,"."),1
      Call VerificaEsitoTurbo(very,ar,fine + 1,2,,,,,retestratti,retidestr)
      If retestratti <> "" Then
         ColoreTesto(2)
         Scrivi retidestr & "  Colpo n." & Format2(retidestr - fine) & "   " & retestratti,1
         ColoreTesto(0)
      End If
   End If
   Scrivi:Scrivi "Situazione Corrente Ritardo a Tutte ",1,2,4
   For z = 1 To v
      rc = EstrattoRitardo(11,very(z),fine - 50,fine)
      Scrivi "Estratto  " & Format2(very(z)) & "  R.c." & Format2(rc),1,6,2
   Next
   Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
End Function
 
grazie Luigi, devo mettere 0 e non solo la virgola.

e non mettere i : ma metterli su righe diverse.

okey di nuovo grazie



piu tardi mi vedo la partita dell'atalanta
 
Ciao Luigi

di nuovo a disturbarti,

ma c'è una versione di questo file "ModSpazioScript" più recente, trovata in (spazioscript v.1.0.0.7 by Luigi )
quando l'avevi offerto qualche anno fa, la mia versione è datata 04/02/2018.

.


mentre spaziometria ho la versione 1.6.34 perchè continuo avere diversi e vari errori, nelle compilazioni degli script


ma con il programma spazioscript si possono solo richiamare gli script, ma non creare exe?
 
Luigi
poichè nel passato ho fatto un buon uso delle tabelle esportabili in excel, ordinabili le colonne etc,

può essere che diversi errori, in compilazione, siano dovuti a questo uso che ho fatto delle istruzioni di questo tipo?
 
bisogna sempre vvedere che errori sono ... quell idi ieri eran oerroi che ci saarebebro stati pure senza compilare.
 
ciao Luigi
ho una domanda sul progetto vb6, e collaborazione varia ed eventuale.

ma con lo sviluppo nuovo è possibile utilizzare le istruzioni/funzione tipo spaziometria per leggere e scrivere file
effettuarci sopra statistiche etc,,, ho bisogna creare il tutto nuovo.?
 
ciao si tratta di un progetto ex novo assolutamente indipendente da spaziometria. ...
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 11 gennaio 2025
    Bari
    73
    43
    01
    58
    81
    Cagliari
    69
    60
    18
    02
    10
    Firenze
    25
    32
    18
    55
    54
    Genova
    48
    05
    40
    34
    69
    Milano
    10
    07
    70
    44
    79
    Napoli
    11
    89
    01
    34
    80
    Palermo
    37
    80
    82
    44
    77
    Roma
    78
    04
    38
    39
    56
    Torino
    08
    13
    30
    27
    24
    Venezia
    56
    75
    36
    18
    70
    Nazionale
    63
    83
    19
    31
    80
    Estrazione Simbolotto
    Bari
    35
    34
    12
    23
    20
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto