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
    sabato 18 ottobre 2025
    Bari
    23
    03
    54
    34
    30
    Cagliari
    49
    14
    25
    09
    37
    Firenze
    32
    45
    15
    59
    29
    Genova
    03
    66
    68
    90
    85
    Milano
    88
    15
    21
    41
    27
    Napoli
    79
    72
    84
    27
    01
    Palermo
    23
    03
    73
    25
    04
    Roma
    11
    67
    24
    13
    59
    Torino
    72
    59
    84
    75
    26
    Venezia
    81
    08
    18
    76
    25
    Nazionale
    58
    69
    62
    17
    70
    Estrazione Simbolotto
    08
    26
    28
    22
    40
Indietro
Alto