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 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

Ultimi Messaggi

Indietro
Alto