Questi due script credo siano molto interessanti ma...

lotto_tom75 · 8 Aprile 2019

Questi due script senza "firma" e presenti nella cartella script "vari" del programma credo siano molto interessanti almeno dal punto di vista del loro nome file relativo. Purtroppo però entrambi danno errore quasi subito. A voi funzionano? E comunque come rimediare all'attuale blocco in run time? Grazie

script: AmbiACopertura

Codice:

Option Explicit
Class clsAmbo
   Private aNum(2)
   Private aCicli()
   Private bUsato
   Private QcicliCopertiSeUsato
   Private sBit
   Property Get Bit
      Bit = sBit
   End Property
   Property Let Usato(b)
      bUsato = b
   End Property
   Property Get Usato
      Usato = bUsato
   End Property
   Property Let QCicli(v)
      ReDim aCicli(v)
   End Property
   Property Get QCicliCopertiSeInUso
      QCicliCopertiSeInUso = QcicliCopertiSeUsato
   End Property
   Property Get QuantitaCicliRapp
      Dim k,q
      q = 0
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            q = q + 1
         End If
      Next
      QuantitaCicliRapp = q
   End Property
   Sub SetFlagCiclo(id,b)
      aCicli(id) = b
   End Sub
   Function GetFlagCiclo(id)
      GetFlagCiclo = aCicli(id)
   End Function
   Sub SetNumero(id,v)
      aNum(id) = v
   End Sub
   Function GetNumeriString
      GetNumeriString = StringaNumeri(aNum,,True)
   End Function
   Sub GetNumeri(aRet)
      Dim k
      ReDim aRet(UBound(aNum))

      For k = 1 To UBound(aNum)
         aRet(k) = aNum(k)
      Next
   End Sub
   Sub AggiornaCicliCoperti
      Dim k
      sBit = ""
      QcicliCopertiSeUsato = QuantitaCicliRapp
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            sBit = sBit & "X"
         Else
            sBit = sBit & " "
         End If
      Next

   End Sub
End Class
Sub Main
   Dim CollAmbi,CollAmbiTrov
   Dim Inizio,Fine,nTotNelRange
   Dim nLenCiclo,qCicli
   Dim idCiclo,k
   Dim Ruota
   Dim cAmbo
   Dim nTrovati

   ReDim aRuote(1)
   ReDim aPoste(2)


   nTrovati = 0
   Ruota = ScegliRuota
   nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))

   aRuote(1) = Ruota
   aPoste(2) = 1
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nTotNelRange =(Fine + 1) - Inizio

   If nTotNelRange Mod nLenCiclo <> 0 Then
      If MsgBox("Per ottenere un analisi sui cicli completi bisogna modificare il range di inizio , Modifico automaticamente ?") = vbYes Then
         Inizio = Inizio -(nTotNelRange Mod nLenCiclo)

         If Inizio < 0 Then
            MsgBox "Con la modifica automatica il range inizio non è valido"

         Else
            nTotNelRange =(Fine + 1) - Inizio
            MsgBox "Modifica Limite Iniziale eseguita. Si ottengono " & nTotNelRange /nLenCiclo & " cicli completi",vbInformation
         End If
      End If
   End If

   If nTotNelRange Mod nLenCiclo = 0 Then
      qCicli = nTotNelRange /nLenCiclo
   Else
      qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
   End If

   Call InitCollAmbi(CollAmbi,qCicli)

   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)

   Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,CollAmbi)

   Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)

   Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)








End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
   Dim idCiclo,k

   Dim cAmbo
   nTrovati = 0
   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call InitACicli(aCicli,nLenCiclo,Inizio)
   Do
      For idCiclo = 1 To qCicli
         If aCicli(idCiclo,2) = 0 Then
            For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
               Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
            Next
         End If
         Call AvanzamentoElab(1,qCicli,idCiclo)
         If ScriptInterrotto Then Exit Sub
      Next
      Call GetAmboConPiuCopertura(cAmbo,collAmbi)
      If Not cAmbo Is Nothing Then
         nTrovati = nTrovati + 1
         cAmbo.Usato = True
         Call cAmbo.AggiornaCicliCoperti
         For idCiclo = 1 To qCicli
            If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
               aCicli(idCiclo,2) = 1
            End If
         Next
      Else
         Exit Do
      End If
      Call Messaggio("Ambi trovati " & nTrovati)
      Call AzzeraCopertura(collAmbi,qCicli)
      If ScriptInterrotto Then Exit Sub

   Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
   Dim idCiclo,k
   Dim cAmbo

   Call Messaggio("Analisi Giocate")
   For idCiclo = 1 To qCicli
      k = 0
      For Each cAmbo In CollAmbi
         If cAmbo.usato Then
            k = k + 1
            ReDim aNum(0)
            Call cAmbo.GetNumeri(aNum)
            Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
            'Call Scrivi(StringaNumeri(aNum))
         End If
      Next
      Call Gioca(aCicli(idCiclo,0) - 1,True)
      Call AvanzamentoElab(1,qCicli,idCiclo)
      If ScriptInterrotto Then Exit Sub

   Next





   k = 0
   For Each cAmbo In CollAmbi
         If cAmbo.usato Then
            k = k + 1
            ReDim aNum(0)
            Call cAmbo.GetNumeri(aNum)
            Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
            'Call Scrivi(StringaNumeri(aNum))
         End If
   Next
   Call Gioca(aCicli(qCicli,1))


   Call ScriviResoconto()

End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)


   Dim cAmbo
   Dim idCiclo,k
   Dim sTmp
   Dim sRigaBit
   Call Scrivi("Quadro copertura ambi")



   ReDim aT(3 + qCicli)
   aT(1) = " N. "
   aT(2) = " Ambo "
   aT(3) = " Cicli coperti "
   For k = 1 To qCicli
      aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
   Next

   Call Messaggio("Creazione tabella copertura")
   Call InitTabella(aT)
   ReDim aLineeBit(nTrovati)
   nTrovati = 0
   For Each cAmbo In CollAmbi
      If cAmbo.usato Then
         nTrovati = nTrovati + 1
         aLineeBit(nTrovati) = cAmbo.Bit

         ReDim aT(3 + qCicli)
         aT(1) = nTrovati
         aT(2) = cAmbo.GetNumeriString
         aT(3) = cAmbo.QCicliCopertiSeInUso
         For k = 1 To qCicli
            aT(k + 3) = Mid(cAmbo.Bit,k,1)
         Next
         ReDim aColoreCelle(UBound(aT))
         Call ImpostaArrayColoreCelle(aColoreCelle,aT)
         Call AddRigaTabella(aT,aColoreCelle)
      End If
      If ScriptInterrotto Then Exit Sub

   Next



   sRigaBit = ""
   For idCiclo = 1 To qCicli
      sTmp = "-"
      For k = 1 To UBound(aLineeBit)
         If Mid(aLineeBit(k),idCiclo,1) = "X" Then
            sTmp = "X"
            Exit For
         End If
      Next
      sRigaBit = sRigaBit & sTmp
   Next
   'Call Scrivi(Space(20) & sRigaBit)
   ReDim aT(3 + qCicli)

   For k = 1 To qCicli
      aT(k + 3) = Mid(sRigaBit,k,1)

   Next
   ReDim aColoreCelle(UBound(aT))
   Call ImpostaArrayColoreCelle(aColoreCelle,aT)
   Call AddRigaTabella(aT,aColoreCelle)
   Call CreaTabella

End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,Collambi)
   Dim sTmp
   Dim cAmbo
   Call Scrivi(String(100,"."))

   Call Scrivi("Ruota                     : " & NomeRuota(Ruota))
   Call Scrivi("Periodo                   : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
   Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
   Call Scrivi("Totale attacchi           : " & qCicli)
   Call Scrivi
   Call Scrivi(Space(20) & "Descrizione del gioco",True)

   Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
   Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
   Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
   Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")



   Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
   Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)

   Call Scrivi(String(100,"."))

   Call Scrivi()

   sTmp = ""
   For Each cAmbo In Collambi
      If cAmbo.usato Then
         sTmp = sTmp &(cAmbo.GetNumeriString) & ","
      End If
   Next
   sTmp = Left(sTmp,Len(sTmp) - 1)
   Call Scrivi("Ambi in gioco  : " & sTmp)

   Call Scrivi(String(100,"."))

   Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
   Dim k

   For k = 1 To UBound(aT)
      If aT(k) = "X" Then
         aColoreCelle(k) = vbGreen
      Else
         aColoreCelle(k) = vbWhite
      End If
   Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)

   Dim k
   Dim sChr
   Dim sTmp

   sTmp = FormatSpace(nInizio,4,True)
   For k = 1 To 4
      sChr = Mid(sTmp,k,1)
      Call InsCar(aRighe(k),sChr,idCiclo)

   Next

   sTmp = FormatSpace(nFine,4,True)
   For k = 6 To 9
      sChr = Mid(sTmp,k - 5,1)
      Call InsCar(aRighe(k),sChr,idCiclo)

   Next


End Sub
Sub InsCar(sRiga,sChr,nPos)

   Dim sLeft
   Dim sRight

   sLeft = Left(sRiga,nPos - 1)
   sRight = Mid(sRiga,nPos + 1)
   sRiga = sLeft & sChr & sRight


End Sub
Function IsScoperto(aCicli,qCicli)
   Dim k,b
   b = False

   For k = 1 To qCicli
      If aCicli(k,2) = 0 Then
         b = True
         Exit For
      End If
   Next
   IsScoperto = b
End Function

Sub AzzeraCopertura(CollAmbi,qCicli)
   Dim cAmbo
   For Each cAmbo In CollAmbi
      cAmbo.qCicli = qCicli
   Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
   Dim cAmboTmp
   Dim nMax,n
   nMax = 0
   For Each cAmboTmp In CollAmbi
      n = cAmboTmp.QuantitaCicliRapp
      If n >= nMax Then
         nMax = n
         Set cAmbo = cAmboTmp
      End If
   Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
   Dim k,kk,s
   Dim cAmbo
   ReDim aNum(0)


   If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
      Call OrdinaMatrice(aNum,1)
      For k = 1 To 4
         For kk = k + 1 To 5
            s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
            Set cAmbo = CollAmbi(s)
            Call cAmbo.SetFlagCiclo(idCiclo,1)
         Next
      Next
   End If
End Sub

Sub InitACicli(aCicli,nLenCiclo,Inizio)
   Dim k
   Dim nStart
   nStart = Inizio
   For k = 1 To UBound(aCicli)
      aCicli(k,2) = 0
      aCicli(k,0) = nStart
      aCicli(k,1) =(nStart - 1) + nLenCiclo
      nStart = aCicli(k,1) + 1
   Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
   ' sistemi che generano un elevato numero di combinazioni
   Dim k,e,s
   Dim nClasse
   ReDim aNumeri(90)
   Dim aColonne
   Dim cAmbo
   Set CollAmbi = GetNewCollection
   nClasse = 2 ' sviluppo in ambi
   ' inizializzo i numeri da sviluppare in questo caso 90
   ' ma potrebbero essere anche di meno
   For k = 1 To 90
      aNumeri(k) = k
   Next
   ' sviluppo il sistema valorizzando le colonne sviluppate
   aColonne = SviluppoIntegrale(aNumeri,nClasse)
   ' scrivo le colonne in output
   For k = 1 To UBound(aColonne)
      Set cAmbo = New clsAmbo
      cAmbo.qCicli = qCicli
      s = "k"
      ' ciclo per leggere la colonna k
      For e = 1 To nClasse
         Call cAmbo.SetNumero(e,aColonne(k,e))
         s = s & Format2(aColonne(k,e)) & "-"
      Next
      ' tolgo l'ultimo trattino
      s = Left(s,Len(s) - 1)
      Call CollAmbi.Add(cAmbo,s)
   Next
End Sub

script: AmbiCiclici

Codice:

Option Explicit
Class clsAmbo
   Private aNum(2)
   Private aCicli()
   Private bUsato
   Private QcicliCopertiSeUsato
   Private sBit
   Property Get Bit
      Bit = sBit
   End Property
   Property Let Usato(b)
      bUsato = b
   End Property
   Property Get Usato
      Usato = bUsato
   End Property
   Property Let QCicli(v)
      ReDim aCicli(v)
   End Property
   Property Get QCicliCopertiSeInUso
      QCicliCopertiSeInUso = QcicliCopertiSeUsato
   End Property
   Property Get QuantitaCicliRapp
      Dim k,q
      q = 0
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            q = q + 1
         End If
      Next
      QuantitaCicliRapp = q
   End Property
   Sub SetFlagCiclo(id,b)
      aCicli(id) = b
   End Sub
   Function GetFlagCiclo(id)
      GetFlagCiclo = aCicli(id)
   End Function
   Sub SetNumero(id,v)
      aNum(id) = v
   End Sub
   Function GetNumeriString
      GetNumeriString = StringaNumeri(aNum,,True)
   End Function
   Sub GetNumeri(aRet)
      Dim k
      ReDim aRet(UBound(aNum))
      For k = 1 To UBound(aNum)
         aRet(k) = aNum(k)
      Next
   End Sub
   Sub AggiornaCicliCoperti
      Dim k
      sBit = ""
      QcicliCopertiSeUsato = QuantitaCicliRapp
      For k = 1 To UBound(aCicli)
         If aCicli(k) <> 0 Then
            sBit = sBit & "X"
         Else
            sBit = sBit & " "
         End If
      Next
   End Sub
End Class
Sub Main
   Dim CollAmbi,CollAmbiTrov
   Dim Inizio,Fine,nTotNelRange
   Dim nLenCiclo,qCicli
   Dim idCiclo,k
   Dim Ruota
   Dim cAmbo
   Dim nTrovati
   ReDim aRuote(1)
   ReDim aPoste(2)
   nTrovati = 0
   Ruota = ScegliRuota
   nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))
   aRuote(1) = Ruota
   aPoste(2) = 1
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nTotNelRange =(Fine + 1) - Inizio
   If nTotNelRange Mod nLenCiclo = 0 Then
      qCicli = nTotNelRange /nLenCiclo
   Else
      qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
   End If
   Call InitCollAmbi(CollAmbi,qCicli)
   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
   Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,CollAmbi)
   Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
   Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
   Dim idCiclo,k
   Dim cAmbo
   nTrovati = 0
   ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
   Call InitACicli(aCicli,nLenCiclo,Inizio)
   Do
      For idCiclo = 1 To qCicli
         If aCicli(idCiclo,2) = 0 Then
            For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
               Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
            Next
         End If
         Call AvanzamentoElab(1,qCicli,idCiclo)
         If ScriptInterrotto Then Exit Sub
      Next
      Call GetAmboConPiuCopertura(cAmbo,collAmbi)
      If Not cAmbo Is Nothing Then
         nTrovati = nTrovati + 1
         cAmbo.Usato = True
         Call cAmbo.AggiornaCicliCoperti
         For idCiclo = 1 To qCicli
            If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
               aCicli(idCiclo,2) = 1
            End If
         Next
      Else
         Exit Do
      End If
      Call Messaggio("Ambi trovati " & nTrovati)
      Call AzzeraCopertura(collAmbi,qCicli)
      If ScriptInterrotto Then Exit Sub
   Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
   Dim idCiclo,k
   Dim cAmbo
   Call Messaggio("Analisi Giocate")
   For idCiclo = 1 To qCicli
      k = 0
      For Each cAmbo In CollAmbi
         If cAmbo.usato Then
            k = k + 1
            ReDim aNum(0)
            Call cAmbo.GetNumeri(aNum)
            Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
            'Call Scrivi(StringaNumeri(aNum))
         End If
      Next
      Call Gioca(aCicli(idCiclo,0) - 1,True)
      Call AvanzamentoElab(1,qCicli,idCiclo)
      If ScriptInterrotto Then Exit Sub
   Next
   Call ScriviResoconto
End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
   Dim cAmbo
   Dim idCiclo,k
   Dim sTmp
   Dim sRigaBit
   Call Scrivi("Quadro copertura ambi")
   ReDim aT(3 + qCicli)
   aT(1) = " N. "
   aT(2) = " Ambo "
   aT(3) = " Cicli coperti "
   For k = 1 To qCicli
      aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
   Next
   Call Messaggio("Creazione tabella copertura")
   Call InitTabella(aT)
   ReDim aLineeBit(nTrovati)
   nTrovati = 0
   For Each cAmbo In CollAmbi
      If cAmbo.usato Then
         nTrovati = nTrovati + 1
         aLineeBit(nTrovati) = cAmbo.Bit
         ReDim aT(3 + qCicli)
         aT(1) = nTrovati
         aT(2) = cAmbo.GetNumeriString
         aT(3) = cAmbo.QCicliCopertiSeInUso
         For k = 1 To qCicli
            aT(k + 3) = Mid(cAmbo.Bit,k,1)
         Next
         ReDim aColoreCelle(UBound(aT))
         Call ImpostaArrayColoreCelle(aColoreCelle,aT)
         Call AddRigaTabella(aT,aColoreCelle)
      End If
      If ScriptInterrotto Then Exit Sub
   Next
   sRigaBit = ""
   For idCiclo = 1 To qCicli
      sTmp = "-"
      For k = 1 To UBound(aLineeBit)
         If Mid(aLineeBit(k),idCiclo,1) = "X" Then
            sTmp = "X"
            Exit For
         End If
      Next
      sRigaBit = sRigaBit & sTmp
   Next
   'Call Scrivi(Space(20) & sRigaBit)
   ReDim aT(3 + qCicli)
   For k = 1 To qCicli
      aT(k + 3) = Mid(sRigaBit,k,1)
   Next
   ReDim aColoreCelle(UBound(aT))
   Call ImpostaArrayColoreCelle(aColoreCelle,aT)
   Call AddRigaTabella(aT,aColoreCelle)
   Call CreaTabella
End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,Collambi)
   Dim sTmp
   Dim cAmbo
   Call Scrivi(String(100,"."))
   Call Scrivi("Ruota : " & NomeRuota(Ruota))
   Call Scrivi("Periodo : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
   Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
   Call Scrivi("Totale attacchi : " & qCicli)
   Call Scrivi
   Call Scrivi(Space(20) & "Descrizione del gioco",True)
   Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
   Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
   Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
   Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")
   Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
   Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)
   Call Scrivi(String(100,"."))
   Call Scrivi()
   sTmp = ""
   For Each cAmbo In Collambi
      If cAmbo.usato Then
         sTmp = sTmp &(cAmbo.GetNumeriString) & ","
      End If
   Next
   sTmp = Left(sTmp,Len(sTmp) - 1)
   Call Scrivi("Ambi in gioco : " & sTmp)
   Call Scrivi(String(100,"."))
   Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
   Dim k
   For k = 1 To UBound(aT)
      If aT(k) = "X" Then
         aColoreCelle(k) = vbGreen
      Else
         aColoreCelle(k) = vbWhite
      End If
   Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)
   Dim k
   Dim sChr
   Dim sTmp
   sTmp = FormatSpace(nInizio,4,True)
   For k = 1 To 4
      sChr = Mid(sTmp,k,1)
      Call InsCar(aRighe(k),sChr,idCiclo)
   Next
   sTmp = FormatSpace(nFine,4,True)
   For k = 6 To 9
      sChr = Mid(sTmp,k - 5,1)
      Call InsCar(aRighe(k),sChr,idCiclo)
   Next
End Sub
Sub InsCar(sRiga,sChr,nPos)
   Dim sLeft
   Dim sRight
   sLeft = Left(sRiga,nPos - 1)
   sRight = Mid(sRiga,nPos + 1)
   sRiga = sLeft & sChr & sRight
End Sub
Function IsScoperto(aCicli,qCicli)
   Dim k,b
   b = False
   For k = 1 To qCicli
      If aCicli(k,2) = 0 Then
         b = True
         Exit For
      End If
   Next
   IsScoperto = b
End Function
Sub AzzeraCopertura(CollAmbi,qCicli)
   Dim cAmbo
   For Each cAmbo In CollAmbi
      cAmbo.qCicli = qCicli
   Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
   Dim cAmboTmp
   Dim nMax,n
   nMax = 0
   For Each cAmboTmp In CollAmbi
      n = cAmboTmp.QuantitaCicliRapp
      If n >= nMax Then
         nMax = n
         Set cAmbo = cAmboTmp
      End If
   Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
   Dim k,kk,s
   Dim cAmbo
   ReDim aNum(0)
   If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
      Call OrdinaMatrice(aNum,1)
      For k = 1 To 4
         For kk = k + 1 To 5
            s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
            Set cAmbo = CollAmbi(s)
            Call cAmbo.SetFlagCiclo(idCiclo,1)
         Next
      Next
   End If
End Sub
Sub InitACicli(aCicli,nLenCiclo,Inizio)
   Dim k
   Dim nStart
   nStart = Inizio
   For k = 1 To UBound(aCicli)
      aCicli(k,2) = 0
      aCicli(k,0) = nStart
      aCicli(k,1) =(nStart - 1) + nLenCiclo
      nStart = aCicli(k,1) + 1
   Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
   ' sistemi che generano un elevato numero di combinazioni
   Dim k,e,s
   Dim nClasse
   ReDim aNumeri(90)
   Dim aColonne
   Dim cAmbo
   Set CollAmbi = GetNewCollection
   nClasse = 2 ' sviluppo in ambi
   ' inizializzo i numeri da sviluppare in questo caso 90
   ' ma potrebbero essere anche di meno
   For k = 1 To 90
      aNumeri(k) = k
   Next
   ' sviluppo il sistema valorizzando le colonne sviluppate
   aColonne = SviluppoIntegrale(aNumeri,nClasse)
   ' scrivo le colonne in output
   For k = 1 To UBound(aColonne)
      Set cAmbo = New clsAmbo
      cAmbo.qCicli = qCicli
      s = "k"
      ' ciclo per leggere la colonna k
      For e = 1 To nClasse
         Call cAmbo.SetNumero(e,aColonne(k,e))
         s = s & Format2(aColonne(k,e)) & "-"
      Next
      ' tolgo l'ultimo trattino
      s = Left(s,Len(s) - 1)
      Call CollAmbi.Add(cAmbo,s)
   Next
End Sub

LuigiB · 8 Aprile 2019

ciao tom , premesso che lo script serve a una sega come dicono in toscana per farlo funzionare o imposti il range in maniera che ci siano ancora tot estrazioni alla fine dove tot sta per il numero di colpi con cui fai lavorare lo script .
oppure devi sostituire un pezzetto di codice nella Routine GestioneAnalisiGiocate e devi mettere questo

Codice:

 If aCicli(qCicli,1) <= EstrazioniArchivio Then
      Call Gioca( aCicli(qCicli,1))
   End if

sempre ammesso che l'errore a cui fai riferimento tu sia questo ..ma dovrebeb essere cosi dato che a me funziona..

il secondo script non l'ho visto presumo sia qualcosa di simile

lotto_tom75 · 8 Aprile 2019

Grazie Master!

Si effettivamente seguendo il tuo consiglio e accorciando il range (es. valutando 2700 estrazioni) non mi da + errore! Ciao e grazie di nuovo Luì

Cerca

Cerca

Questi due script credo siano molto interessanti ma...

lotto_tom75

Advanced Premium Member

LuigiB

Guest

lotto_tom75

Advanced Premium Member

Ultima estrazione Lotto

Ultimi Messaggi