Novità

X LuigiB

R

Rosanna58

Member
Buonasera LuigiB, gironzolando in internet ho trovato questo suo script datato aprile 2011 riguardante, se ho capito bene, i cicli reali di numeri capogioco.
Purtroppo eseguendolo mi da' errori del tipo: 1017 - era atteso ' THEN ' oppure era atteso ' ) ' .
Queste istruzioni sono presenti nello script e non capisco perche' non vengono lette.
Inoltre ci sono alcune istruzioni e alcune variabili che non si "colorano" indicando forse altri errori.
La versione di SPMT e' la 1.6.31 e il S.O. e' Xp.
Grazie in anticipo per il tempo che vorra' dedicarmi.


Codice: 
Option Explicit
Class clsAmbo
Public abNum(90)
Public aNum(2)
Public Capogioco
Public nCicliDaCalc
Public PresPerCicliPratici
Public PresenzeAttuali
Sub InitCicliDaCalc(nCicliDaCalc)

Dim k
PresenzeAttuali = 0
ReDim PresPerCicliPratici(nCicliDaCalc)
For k = 0 To nCicliDaCalc
PresPerCicliPratici(k) = 0
Next
End Sub

Sub SetAmbo(n1,n2)
abNum(n1) = True
abNum(n2) = True
If n1 < n2 Then
aNum(1) = n1
aNum(2) = n2
Else
aNum(1) = n2
aNum(2) = n1
End If

End Sub

Function GetNumeriString

GetNumeriString = Format2(aNum(1)) & "." & Format2(aNum(2))

End Function

Function GetSommaPresenze

Dim t
Dim k
For k = 1 To UBound(PresPerCicliPratici)
t = t + PresPerCicliPratici(k)
Next
GetSommaPresenze = t
End Function
End Class

Sub Main

Dim CollAmbi
Dim clsA
Dim nCapogioco
Dim aRuote,abRuote
Dim nRuoteSel
Dim nInizioRangeAnalisi
Dim nFineRangeAnalisi
Dim nInizioTmp
Dim retInizioCiclo,retFineCicloDim aLimitiCicli

Dim k,j
Dim nCicliTrovati
Dim nNumScelti

' attenzione il range analizzato parte dall'estrazione del 14/9/1946 fino all'estrazione corrrentemente impostata
' come limite superiore nel range del programma

nInizioRangeAnalisi = DataEstrToIdEstr(14,9,1946)

nFineRangeAnalisi = EstrazioneFin

'nCapogioco = InputBox("Inserire un numero per il capogioco","Capogioco",1)

ReDim aNumeri(0)

nNumScelti = ScegliNumeri(aNumeri)

nRuoteSel = ScegliRuote(aRuote,abRuote)

Call GestioneAutomaticaRuotaTutte(aRuote,abRuote,nRuote Sel)

If nCapogioco <> "" Then nCapogioco = CInt(nCapogioco)




If nRuoteSel > 0 And nNumScelti > 0 Then

Call Scrivi("Inizio analisi " & GetInfoEstrazione(nInizioRangeAnalisi))

Call Scrivi("Fine analisi " & GetInfoEstrazione(nFineRangeAnalisi))

Call Scrivi


Set CollAmbi = GetNewCollection

For j = 1 To nNumScelti

nCapogioco = aNumeri(j)

nCicliTrovati = 0

ReDim aLimitiCicliMin(nCicliTrovati)

ReDim aLimitiCicliMax(nCicliTrovati)

Call AlimentaCollAmbi(CollAmbi,nCapogioco)

nInizioTmp = nInizioRangeAnalisi

retInizioCiclo = 0

retFineCiclo = 0

Do While CalcolaCicloPratico(nInizioTmp,retInizioCiclo,retF ineCiclo,nCapogioco,abRuote,nFineRangeAnalisi)

nCicliTrovati = nCicliTrovati + 1

ReDim Preserve aLimitiCicliMin(nCicliTrovati)

ReDim Preserve aLimitiCicliMax(nCicliTrovati)

aLimitiCicliMin(nCicliTrovati) = retInizioCiclo

aLimitiCicliMax(nCicliTrovati) = retFineCiclo

nInizioTmp = retFineCiclo + 1

Loop

ReDim abCicliDaCalcolare(nCicliTrovati)

If ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicl iMax,abCicliDaCalcolare) Then

For Each clsA In CollAmbi

Call clsA.InitCicliDaCalc(nCicliTrovati)

Next

For k = 1 To nCicliTrovati

If abCicliDaCalcolare(k) Then

Call Messaggio("Conteggio presenze nel ciclo " & k & _

" estrazioni " & aLimitiCicliMin(k) & "/" & aLimitiCicliMax(k))

Call CalcolaPresenze(k,aLimitiCicliMin(k),aLimitiCicliM ax(k),CollAmbi,abRuote)

End If

Next

nInizioTmp = aLimitiCicliMax(nCicliTrovati) + 1

Call Messaggio("Conteggio presenze nel ciclo finale incompleto")

Call CalcolaPresenze(0,nInizioTmp,nFineRangeAnalisi,Col lAmbi,abRuote)

Call creaOutputRangeCicli(aLimitiCicliMin,aLimitiCicliM ax,nCapogioco,aRuote,nFineRangeAnalisi)

End If

Next



Call CreaOutputPresenzeAmbi(CollAmbi,abCicliDaCalcolare )

End If

End Sub

Function ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicl iMax,abCicliDaCalcolare)

Dim k

ReDim aVoci(UBound(abCicliDaCalcolare) - 1)

ReDim abSelected(UBound(abCicliDaCalcolare) - 1)

For k = 0 To UBound(aVoci)

aVoci(k) = "Ciclo " & FormatSpace(k + 1,4,True) & " da " & FormatSpace(aLimitiCicliMin(k + 1),5,2) & " a " & FormatSpace(aLimitiCicliMax(k + 1),5,2)

Next

If ScegliDaLista(aVoci,abSelected,"Scegli i cicli da analizzare") > 0 Then

For k = 0 To UBoun
 
ciao , lo script che hai postato non è completo non vorrei che tu lo abbia copiato male da dove lo hai preso perche se cosi è ovvio che non funzioni...e non si puo sistemare perche manca un pezzo ..
 
Intanto grazie per l'attenzione, lo script l'ho copiato da una discussione chiusa qua su lottoced
Risultati web
Richiesta per listato su statistica di cicli reali - LottoCED Forum
https://forum.lottoced.com › lottoced › 8...
e ho ricontrollato ma ho copiato tutto.
​​​​​​​Se il link non funziona basta cercare cicli reali lotto sul motore di ricerca
 
tutti gli script devono finire o con End Sub o con End Function ... questo è l'unico aiuto che posso darti.
 
Ciao Luigi, Rosanna58, potrebbe essere questo, completo

Codice: 
Option Explicit
Class clsAmbo
   Public abNum(90)
   Public aNum(2)
   Public Capogioco
   Public nCicliDaCalc
   Public PresPerCicliPratici
   Public PresenzeAttuali
   Sub InitCicliDaCalc(nCicliDaCalc)
      Dim k
      PresenzeAttuali = 0
      ReDim PresPerCicliPratici(nCicliDaCalc)
      For k = 0 To nCicliDaCalc
         PresPerCicliPratici(k) = 0
      Next
   End Sub
   Sub SetAmbo(n1,n2)
      abNum(n1) = True
      abNum(n2) = True
      If n1 < n2 Then
         aNum(1) = n1
         aNum(2) = n2
      Else
         aNum(1) = n2
         aNum(2) = n1
      End If
   End Sub
   Function GetNumeriString
      GetNumeriString = Format2(aNum(1)) & "." & Format2(aNum(2))
   End Function
   Function GetSommaPresenze
      Dim t
      Dim k
      For k = 1 To UBound(PresPerCicliPratici)
         t = t + PresPerCicliPratici(k)
      Next
      GetSommaPresenze = t
   End Function
End Class
Sub Main
   Dim CollAmbi
   Dim clsA
   Dim nCapogioco
   Dim aRuote,abRuote
   Dim nRuoteSel
   Dim nInizioRangeAnalisi
   Dim nFineRangeAnalisi
   Dim nInizioTmp
   Dim retInizioCiclo,retFineCiclo
   Dim aLimitiCicli
   Dim k,j
   Dim nCicliTrovati
   Dim nNumScelti
   ' attenzione il range analizzato parte dall'estrazione del 14/9/1946 fino all'estrazione corrrentemente impostata
   ' come limite superiore nel range del programma
   nInizioRangeAnalisi = DataEstrToIdEstr(14,9,1946)
   nFineRangeAnalisi = EstrazioneFin
   'nCapogioco = InputBox("Inserire un numero per il capogioco","Capogioco",1)
   ReDim aNumeri(0)
   nNumScelti = ScegliNumeri(aNumeri)
   nRuoteSel = ScegliRuote(aRuote,abRuote)
   Call GestioneAutomaticaRuotaTutte(aRuote,abRuote,nRuoteSel)
   If nCapogioco <> "" Then nCapogioco = CInt(nCapogioco)



   If nRuoteSel > 0 And nNumScelti > 0 Then
      Call Scrivi("Inizio analisi " & GetInfoEstrazione(nInizioRangeAnalisi))
      Call Scrivi("Fine analisi   " & GetInfoEstrazione(nFineRangeAnalisi))
      Call Scrivi

      Set CollAmbi = GetNewCollection
      For j = 1 To nNumScelti
         nCapogioco = aNumeri(j)
         nCicliTrovati = 0
         ReDim aLimitiCicliMin(nCicliTrovati)
         ReDim aLimitiCicliMax(nCicliTrovati)
         Call AlimentaCollAmbi(CollAmbi,nCapogioco)
         nInizioTmp = nInizioRangeAnalisi
         retInizioCiclo = 0
         retFineCiclo = 0
         Do While CalcolaCicloPratico(nInizioTmp,retInizioCiclo,retFineCiclo,nCapogioco,abRuote,nFineRangeAnalisi)
            nCicliTrovati = nCicliTrovati + 1
            ReDim Preserve aLimitiCicliMin(nCicliTrovati)
            ReDim Preserve aLimitiCicliMax(nCicliTrovati)
            aLimitiCicliMin(nCicliTrovati) = retInizioCiclo
            aLimitiCicliMax(nCicliTrovati) = retFineCiclo
            nInizioTmp = retFineCiclo + 1
         Loop
         ReDim abCicliDaCalcolare(nCicliTrovati)
         If ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco) Then
            For Each clsA In CollAmbi
               Call clsA.InitCicliDaCalc(nCicliTrovati)
            Next
            For k = 1 To nCicliTrovati
               If abCicliDaCalcolare(k) Then
                  Call Messaggio("Conteggio presenze nel ciclo " & k & _
                  " estrazioni " & aLimitiCicliMin(k) & "/" & aLimitiCicliMax(k))
                  Call CalcolaPresenze(k,aLimitiCicliMin(k),aLimitiCicliMax(k),CollAmbi,abRuote)
               End If
            Next
            nInizioTmp = aLimitiCicliMax(nCicliTrovati) + 1
            Call Messaggio("Conteggio presenze nel ciclo finale incompleto")
            Call CalcolaPresenze(0,nInizioTmp,nFineRangeAnalisi,CollAmbi,abRuote)
            Call creaOutputRangeCicli(aLimitiCicliMin,aLimitiCicliMax,nCapogioco,aRuote,nFineRangeAnalisi)
         End If
      Next


      Call CreaOutputPresenzeAmbi(CollAmbi,abCicliDaCalcolare)
   End If
End Sub
Function ScegliCicliDaCalcolare(aLimitiCicliMin,aLimitiCicliMax,abCicliDaCalcolare,nCapogioco)
   Dim k
   ReDim aVoci(UBound(abCicliDaCalcolare) - 1)
   ReDim abSelected(UBound(abCicliDaCalcolare) - 1)
   For k = 0 To UBound(aVoci)
      aVoci(k) = "Ciclo " & FormatSpace(k + 1,4,True) & " da " & FormatSpace(aLimitiCicliMin(k + 1),5,2) & " a " & FormatSpace(aLimitiCicliMax(k + 1),5,2)
   Next
   If ScegliDaLista(aVoci,abSelected,"Cicli del capogioco " & nCapogioco) > 0 Then
      For k = 0 To UBound(abSelected)
         abCicliDaCalcolare(k + 1) = abSelected(k)
      Next
      ScegliCicliDaCalcolare = True
   Else
      ScegliCicliDaCalcolare = False
   End If
End Function
Sub GestioneAutomaticaRuotaTutte(aRuote,aBRuote,nRuoteSel)
   Dim k
   If aBRuote(11) Then
      ReDim aRuote(11)
      ReDim aBRuote(11)
      For k = 1 To 10
         aBRuote(k) = True
         aRuote(k) = k
      Next
   ElseIf aBRuote(12) Then
      MsgBox "Lo script non opera sulla nazionale",vbExclamation
      nRuoteSel = 0
   End If
End Sub
Sub AlimentaCollAmbi(CollAmbi,nCapogioco)
   Dim k
   Dim clsA
   For k = 1 To 90
      If k <> nCapogioco Then
         Set clsA = New clsAmbo
         Call clsA.SetAmbo(nCapogioco,k)
         clsA.Capogioco = nCapogioco
         CollAmbi.Add clsA
      End If
   Next
End Sub
Function CalcolaCicloPratico(Inizio,retInizio,retFine,nCapogioco,aBRuote,estrazioniTotali)
   Dim clsA
   Dim idEstr
   Dim r,e,N
   ReDim aBNum(90)
   Dim nTrovati
   idEstr = Inizio
   retInizio = Inizio
   If idEstr <= estrazioniTotali Then
      Do
         For r = 1 To 10
            If aBRuote(r) Then
               If IsNumeroPresenteInEstrazione(idEstr,r,nCapogioco,0) Then
                  For e = 1 To 5
                     N = Estratto(idEstr,r,e)
                     If aBNum(N) = False Then
                        aBNum(N) = True
                        nTrovati = nTrovati + 1
                     End If
                  Next
               End If
            End If
         Next
         Call AvanzamentoElab(1,90,nTrovati)
         idEstr = idEstr + 1
         If idEstr > estrazioniTotali Then Exit Do
         If ScriptInterrotto Then Exit Do
      Loop While nTrovati < 90
      retFine = idEstr - 1
      If nTrovati >= 90 Then
         CalcolaCicloPratico = True
      Else
         CalcolaCicloPratico = False
      End If
   End If
End Function
Function GetRuote(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      If aRuote(k) > 0 Then
         s = s & NomeRuota(aRuote(k)) & "-"
      End If
   Next
   If Len(s) > 1 Then
      GetRuote = Left(s,Len(s) - 1)
   Else
      GetRuote = s
   End If
End Function
Sub creaOutputRangeCicli(aLimitiCicloMin,aLimitiCicloMax,nCapogioco,aRuote,nFineRangeAnalisi)
   Dim k
   Dim s
   Dim nPresenze
   ReDim aNum(1)
   aNum(1) = nCapogioco
   Call Scrivi("Cicli pratici per ambo con capogioco " & nCapogioco)
   Call Scrivi("Ruote " & GetRuote(aRuote))
   Call Scrivi
   For k = 1 To UBound(aLimitiCicloMin)
      Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMin(k),aLimitiCicloMax(k))
      s = "Ciclo            " & FormatSpace(k,5,True) & " -->  " & _
      FormatSpace(aLimitiCicloMin(k),8,True) & " - " & FormatSpace(aLimitiCicloMax(k),8,True) & _
      " pres capogioco " & FormatSpace(nPresenze,5,True)
      Call Scrivi(s)
   Next
   Call StatisticaFormazione(aNum,aRuote,1,0,0,0,nPresenze,aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,nFineRangeAnalisi)
   s = "Ciclo incompleto " & FormatSpace(k,5,True) & " -->  " & _
   FormatSpace(aLimitiCicloMax(UBound(aLimitiCicloMax)) + 1,8,True) & " - " & FormatSpace(nFineRangeAnalisi,8,True) & _
   " pres capogioco " & FormatSpace(nPresenze,5,True)
   Call Scrivi(s)
   Call Scrivi
End Sub
Sub CalcolaPresenze(idCiclo,Inizio,Fine,collAmbi,aBRuote)
   Dim clsA
   Dim k,r,e,p
   Dim nAmbiTot,nLetti
   nAmbiTot = collAmbi.count
   For Each clsA In collAmbi
      For k = Inizio To Fine
         For r = 1 To 10
            If aBRuote(r) Then
               p = 0
               For e = 1 To 5
                  If clsA.abNum(Estratto(k,r,e)) Then
                     p = p + 1
                  End If
               Next
               If p = 2 Then
                  If idCiclo > 0 Then
                     clsA.PresPerCicliPratici(idCiclo) = clsA.PresPerCicliPratici(idCiclo) + 1
                  Else
                     clsA.PresenzeAttuali = clsA.PresenzeAttuali + 1
                  End If
               End If
            End If
         Next
      Next
      nLetti = nLetti + 1
      Call AvanzamentoElab(1,nAmbiTot,nLetti)
      If ScriptInterrotto Then Exit For
   Next
End Sub
Function ContaValoriTrue(aB)
   Dim k,n
   For k = LBound(aB) To UBound(aB)
      If aB(k) Then n = n + 1
   Next
   ContaValoriTrue = n
End Function
Sub CreaOutputPresenzeAmbi(CollAmbi,aBCicliDaCalcolare)
   Dim clsA
   Dim nColonne
   Dim k,i
   Dim nIdColSomma,nIdColPresAtt
   Dim nCicliDaCalcolare
   Dim nCicliTot
   nCicliTot = UBound(aBCicliDaCalcolare)
   nCicliDaCalcolare = ContaValoriTrue(aBCicliDaCalcolare)
   nColonne = 1 + nCicliDaCalcolare + 1 + 1
   nIdColSomma = nColonne
   nIdColPresAtt = nIdColSomma - 1
   ReDim aTitoli(nColonne)
   i = 1
   aTitoli(i) = "Ambo"
   For k = 1 To nCicliTot
      If aBCicliDaCalcolare(k) Then
         i = i + 1
         aTitoli(i) = "Freq C" & k
      End If
   Next
   aTitoli(nIdColPresAtt) = "Presenze Attuali"
   aTitoli(nIdColSomma) = "Somma"
   Call InitTabella(aTitoli,vbYellow)
   For Each clsA In CollAmbi
      ReDim aValori(nColonne)
      i = 1
      aValori(i) = clsA.GetNumeriString
      For k = 1 To nCicliTot
         If aBCicliDaCalcolare(k) Then
            i = i + 1
            aValori(i) = clsA.PresPerCicliPratici(k)
         End If
      Next
      aValori(nIdColPresAtt) = clsA.PresenzeAttuali
      aValori(nIdColSomma) = clsA.GetSommaPresenze
      Call AddRigaTabella(aValori)
   Next
   Call CreaTabella(nIdColSomma,1) 'ordina per somma  crescente
End Sub
 
Ultima modifica:
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 16 gennaio 2025
    Bari
    47
    33
    54
    51
    58
    Cagliari
    58
    88
    03
    30
    65
    Firenze
    76
    56
    16
    73
    29
    Genova
    78
    58
    71
    18
    26
    Milano
    09
    74
    15
    26
    57
    Napoli
    75
    81
    35
    59
    17
    Palermo
    17
    39
    46
    54
    08
    Roma
    28
    75
    76
    02
    23
    Torino
    24
    36
    80
    87
    89
    Venezia
    86
    70
    37
    23
    45
    Nazionale
    09
    65
    30
    06
    07
    Estrazione Simbolotto
    Bari
    21
    43
    01
    02
    19
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto