Novità

A GENTIL RICHIESTA...

Codice:
Option Explicit
Class clsSviluppo
   Private aBNumDaSvil
   Private nQNumeri
   Private nCombInt
   Private nClasse
   Private aRighe
   Private nQNumPerRiga
   Private aPuntatore
   Private nSviluppate
   Function InitSviluppo(aNumeri,Classe)
      nQNumeri = AlimentArrayNumDaSvil(aNumeri)
      nCombInt = Combinazioni(nQNumeri,Classe)
      nClasse = Classe
      nSviluppate = 0
      If nCombInt > 0 Then
         Call AlimentaArrayRighe
         Call InitArrayPuntatore
      End If
      InitSviluppo = nCombInt
   End Function
   Function GetQuantitaNumeriDaSvil
      GetQuantitaNumeriDaSvil = nQNumeri
   End Function
   Function GetStringaNumDaSvil
      Dim s,k
      s = ""
      For k = 1 To UBound(aBNumDaSvil)
         If aBNumDaSvil(k) Then
            s = s & Format2(k) & "."
         End If
      Next
      GetStringaNumDaSvil = RimuoviLastChr(s,".")
   End Function
   Private Sub InitArrayPuntatore
      Dim k
      ReDim aPuntatore(nClasse)
      For k = 1 To nClasse - 1
         aPuntatore(k) = 1
      Next
      aPuntatore(k) = 0
   End Sub
   Function GetComb(aComb)
      Dim nTmp,K,nPuntatore
      nPuntatore = nClasse
      nTmp = aPuntatore(nPuntatore) + 1
      Do While nTmp > nQNumPerRiga
         nPuntatore = nPuntatore - 1
         If nPuntatore <= 0 Then Exit Do
         nTmp = aPuntatore(nPuntatore) + 1
      Loop
      If nPuntatore > 0 Then
         For K = nPuntatore To nClasse
            aPuntatore(K) = nTmp
         Next
         ReDim aComb(nClasse)
         For K = 1 To nClasse
            aComb(K) = aRighe(K,aPuntatore(K))
         Next
         nSviluppate = nSviluppate + 1
         GetComb = True
      Else
         GetComb = False
      End If
   End Function
   Function GetQuantitaSviluppate
      GetQuantitaSviluppate = nSviluppate
   End Function
   Private Function AlimentArrayNumDaSvil(aNumeri)
      Dim k,q
      aBNumDaSvil = ArrayNumeriToBool(aNumeri)
      For k = 1 To 90
         If aBNumDaSvil(k) Then
            q = q + 1
         End If
      Next
      AlimentArrayNumDaSvil = q
   End Function
   Private Sub AlimentaArrayRighe
      Dim nRiga,k,aNumeri
      Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
      nQNumPerRiga =(nQNumeri - nClasse) + 1
      ReDim aRighe(nClasse,nQNumPerRiga)
      For nRiga = 1 To nClasse
         'i = 0
         For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
            ' i = i + 1
            ' i = (k - nRiga )+1
            aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
         Next
      Next
   End Sub
   Sub OutputARighe
      Dim k,j,s
      For k = 1 To nClasse
         s = ""
         For j = 1 To nQNumPerRiga
            s = s & Format2(aRighe(k,j)) & "."
         Next
         Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
      Next
   End Sub
End Class
Sub Main
   Dim clSvi
   Dim nClasse
   Dim nSorte
   Dim k,j
   Dim sNumeri
   Dim idComb
   Dim nInizio,nFine
   Dim idValoreDaAna
   Dim sValoreUsato
   Dim CombTot
   Dim aRuote
   Set clSvi = New clsSviluppo
   Dim quantirisultati
   Dim Col_Ord
   Dim Tipo_Ord
   Dim QNS
   ReDim aNum(0)
   QNS = ScegliNumeri(aNum)
   nClasse = ScegliEsito(2,1,90)
   Call ScegliRuote(aRuote)
   nSorte = ScegliSorte
   idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
   Col_Ord = CInt(InputBox("Colonna da ordinare (freq= 2; Rit= 3; RitMax= 4; Diff= 5; Incmax= 6).","colonna da ordinare ",3))
   Tipo_Ord = CInt(InputBox("Ordinamento (Crescente > 0 1; Decresc = 0).","Ordinamento ",1))
   nInizio = EstrazioneIni
   nFine = EstrazioneFin
   If nClasse > 0 And nSorte > 0 And nSorte <= nClasse And idValoreDaAna > 0 Then
      Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
      CombTot = clSvi.InitSviluppo(aNum,nClasse)
      Call Messaggio("Lunghette totali da analizzare " & CombTot)
      ReDim aCombMigliori(CombTot,6)
      Call Messaggio("Statistica combinazioni in corso ")
      ReDim aCol(nClasse)
      Do While clSvi.GetComb(aCol) = True
         Call AnalisiComb(aCol,aRuote,nSorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
         k = k + 1
         If k Mod 1 = 0 Then
            Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
            Call AvanzamentoElab(1,CombTot,k)
            If ScriptInterrotto Then Exit Do
         End If
      Loop
      Call Messaggio("")
      Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nSorte & " sulle ruote " & GetRuoteUsate(aRuote))
      Call Scrivi("La seguente lista mostra le prime " & quantirisultati & " Combinazioni In Base al valore di " & sValoreUsato)
      Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
      Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
      Call Scrivi
      For k = 1 To UBound(aCombMigliori)
         ReDim ADati(6)
         ADati(1) = aCombMigliori(k,4)
         ADati(2) = aCombMigliori(k,1)
         ADati(3) = aCombMigliori(k,2)
         ADati(4) = aCombMigliori(k,3)
         ADati(5) = aCombMigliori(k,5)
         ADati(6) = aCombMigliori(k,6)
         Dim ccolonna
         Dim contatore
         contatore = contatore + 1
         Dim diff
         If ADati(5) <= 10 Then
            Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore)
         Else
            Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
         End If
      Next
      Call Scrivi
      Call Scrivi("Tempo trascorso: " & TempoTrascorso)
      Call Scrivi
   Else
      MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
      "si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
      "e che bisogna scegliere quale valore statistico considerare per " & _
      "alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
   End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
   Dim k,j
   Dim Rit
   Dim RitMax
   Dim Freq
   Dim Valore
   Dim diff
   Dim RetIncrRitMax
   Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
   diff = RitMax - Rit
   Select Case idValoreDaAna
   Case 1
      Valore = Freq
   Case 2
      Valore = Rit
   Case 3
      Valore = RitMax
   End Select
   For k = 1 To UBound(aCombMig)
      If Valore >= aCombMig(k,0) Then
         For j = UBound(aCombMig) To(k + 1) Step - 1
            aCombMig(j,0) = aCombMig(j - 1,0)
            aCombMig(j,1) = aCombMig(j - 1,1)
            aCombMig(j,2) = aCombMig(j - 1,2)
            aCombMig(j,3) = aCombMig(j - 1,3)
            aCombMig(j,4) = aCombMig(j - 1,4)
            aCombMig(j,5) = aCombMig(j - 1,5)
            aCombMig(j,6) = aCombMig(j - 1,6)
         Next
         aCombMig(k,0) = Valore
         aCombMig(k,1) = Freq
         aCombMig(k,2) = Rit
         aCombMig(k,3) = RitMax
         aCombMig(k,4) = StringaNumeri(aNum)
         aCombMig(k,5) = diff
         aCombMig(k,6) = RetIncrRitMax
         Exit For
      End If
   Next
End Sub
Function ScegliSorte()
   ReDim aVoci(4)
   aVoci(0) = "Estratto"
   aVoci(1) = "Ambo"
   aVoci(2) = "Terno"
   aVoci(3) = "Quaterna"
   aVoci(4) = "Cinquina"
   ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore)
   ReDim aVoci(4)
   Dim i
   aVoci(0) = "Frequenza"
   aVoci(1) = "Ritardo"
   aVoci(2) = "Ritardo massimo"
   aVoci(3) = "Differenza Aurea"
   aVoci(4) = "IncMax"
   i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
   sValore = aVoci(i)
   ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      s = s & SiglaRuota(aRuote(k)) & " "
   Next
   GetRuoteUsate = Trim(s)
End Function
Ciao lotto tom, NON MI GIRA lo script ...mi dice che ha delle istruzioni sbagliate, puoi per favore rimettere lo script senza errori? ciao
 
Ciao lotto tom, NON MI GIRA lo script ...mi dice che ha delle istruzioni sbagliate, puoi per favore rimettere lo script senza errori? ciao

Se lo stai cercando di eseguire su spazio light questo è solo per spaziometria... Ad ogni modo se non è questo il problema fai uno screen shot del messaggio di errore perchè a me quello condiviso su spaziometria funziona... Ciao
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 09 settembre 2025
    Bari
    80
    40
    25
    05
    49
    Cagliari
    88
    51
    28
    38
    67
    Firenze
    83
    86
    78
    03
    77
    Genova
    29
    67
    66
    25
    63
    Milano
    85
    66
    63
    75
    60
    Napoli
    78
    60
    75
    41
    69
    Palermo
    49
    50
    88
    34
    19
    Roma
    40
    47
    61
    57
    09
    Torino
    20
    86
    42
    53
    28
    Venezia
    33
    60
    83
    75
    14
    Nazionale
    87
    81
    08
    22
    78
    Estrazione Simbolotto
    Palermo
    42
    33
    44
    16
    36
Indietro
Alto