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
For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
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(7,1,90)
Call ScegliRuote(aRuote) ' ,BA_)
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 ",2))
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,8)
Call Messaggio("Statistica combinazioni in corso ")
ReDim aCol(nClasse)
Do While clSvi.GetComb(aCol) = True
ReDim aRuotetmp(1)
Dim y
For y = 1 To UBound(aRuote)
aRuotetmp(1) = aRuote(y)
Call AnalisiComb(aCol,aRuotetmp,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
Next
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(8)
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)
ADati(7) = aCombMigliori(k,7)
Dim ccolonna
Dim contatore
contatore = contatore + 1
Dim diff
If ADati(5) <= 10 Then
Call Scrivi("r " & ADati(7) & " 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("r " & ADati(7) & " 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,aRuotetmp,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
Dim k,j
Dim Rit
Dim RitMax
Dim Freq
Dim Valore
Dim diff
Dim RetIncrRitMax
Call StatisticaFormazioneTurbo(aNum,aRuotetmp,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)
aCombMig(j,7) = aCombMig(j - 1,7)
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
aCombMig(k,7) = NomeRuota(aRuotetmp(1))
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,0,"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
a me funziona perche ho sostituito il percorso e non mi ero accorto che nbel tuo c'è un caarattere blank alla fine che non ci deve essere ...
No Luigi a me non funziona.
Non saprei lo vedo strapieno di codici.
questo è il mio percorso quale sarebbe l'errore ?
Class Script
Sub Main()
Dim sFileArc As String = "C:\Users\Miche\Desktop\NewSpazioLight\Archivio\Estrazioni10L.csv"
If ImpostaArchivioFT(sFileArc, 20, 90) Then
Dim ini As Integer = EstrazioniArchivioFT-10
Dim fin As Integer = EstrazioniArchivioFT
Dim aNum() , Nu(20) As Integer
Dim carattere As String = ";"
Dim es , p As Integer
Dim aN(3) As Integer
For es = ini To fin
For p = 1 To 20
Nu(p) = EstrattoFT(es,p)
Next
'---------------------------------
aN(1) = 11
aN(2) = 22
aN(3) = 33
'---------------------------------
Dim Pt As Integer
Pt = PuntiSuArray(aN,Nu)
Scrivi (GetInfoEstrazioneFT(es) & " - " & StringaNumeri (Nu,,1) & " Punti Su Giocato : " & StringaNumeri (aN ) & " = " & Pt)
'Scrivi (StringaEstrattiFT(es,carattere)) disattivo
Next
End If
End Sub
End ClassClass Script
Sub Main
Dim k As Integer
Dim s ,T() As String
Dim nClasse,nColonneTot,aNumeri() As Integer
ReDim aNumeri(90)
Dim aCol(),Ruote() ,r ,sorte As Integer
Dim ini As Integer = 1
Dim fin As Integer = EstrazioniArchivio
Dim rit,max,incr,fre,pre ,ubNum As Integer
nClasse = 9 ' sviluppo in classe
sorte = 2 ' sorte di verifica statistica
ScegliNumeri(aNumeri)
ubNum = UBound(aNumeri)
ScegliRuote(Ruote )
T = {" k " ," Sviluppo " , " Frequenze "," Presenze "," RitardoCoRRente ", "RitardoMax "," IncrMax "}
Call InitTabella(T)
'inizializza lo sviluppo
nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
k = 0
ReDim aCol(nClasse )
' ciclo che continua fiono a quando le colonne non finiscono
Do While GetCombSviluppo (aCol )
k = k + 1 ' conteggio colonna corrente
' costruisco la stringa che contiene la colonna
SerieStat (aCol,Ruote,sorte ,rit,max,fre,pre,incr,ini,fin)
s = StringaNumeri(aCol)
T = {k,s,fre,pre,rit,max,incr }
Call AddRigaTabella(T)
'Call Scrivi(s & vbTab & fre)
Call Messaggio("Colonna " & k)
If ScriptInterrotto Then Exit Do
Loop
Scrivi (StringaNumeri(aNumeri) & " ( " & ubNum & " )" & " Sviluppo In classe : " & nClasse & " Su Ruote Unite " & ArrayRuoteToString(Ruote) )
CreaTabella
End Sub
End Class k | Sviluppo | Frequenze 6 | Presenze | RitardoCoRRente | RitardoMax | IncrMax |
|---|---|---|---|---|---|---|
149 | 71.72.73.82.83.85.86.87.90 | 828 | 729 | 6 | 92 | 0 |
154 | 71.72.73.82.83.85.87.88.90 | 831 | 721 | 6 | 105 | 0 |
155 | 71.72.73.82.83.85.87.89.90 | 835 | 729 | 6 | 108 | 0 |
582 | 72.73.82.83.84.85.86.87.90 | 835 | 729 | 6 | 83 | 0 |
ok scaricato Funzionante
👏no nso .. mi aveva detto che stava passando un periodo impegnativo ..io non ho certo voglia di rifare spaziometriaok scaricato Funzionante
e comunque sei un mostro di bravura.
P.s. Che fine ha fatto Edoardo ??? la creatura bisogna crescerla.
mo gli script ce l iabbiamo messi e qyesto aspetto lo seguo...pero il programam dovrebeb portarl oavanti lui ..
Option Explicit
Sub Main
Dim nEstrInizio,nEstrFine
Dim DataIni,DataFin
Dim sFile
Dim sChrSep
Dim sDirDest
MsgBox "Sostituisci nello script la directory dove verrà creato il file csv" & vbCrLf & "Poi elimina questo messaggio",vbInformation
'sDirDest = "C:\dovemipare\"
sDirDest = GetDirectoryAppData
If DirectoryEsistente(sDirDest) Then
ImpostaArchivio10ELotto(1)
sChrSep = ";"
sFile = AddSlash(sDirDest) & "Estrazioni10L.csv"
If EliminaFile(sFile) Then
nEstrInizio = 1
nEstrFine = EstrazioniArchivioDL
Call EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep)
End If
Else
MsgBox "Directory non trovata" & vbCrLf & sDirDest
End If
End Sub
Sub EsportaEstr(nEstrInizio,nEstrFine,sFile,sChrSep)
Dim k,f,idEstr
Dim sRecord
Dim nProgr
Dim sDataCorr
Dim r,e
For k = nEstrInizio To nEstrFine
Call Messaggio("Estrazione : " & k)
idEstr = k
ReDim aNum(0)
If GetEstrazioneCompletaDL(idEstr,aNum) Then
nProgr = nProgr + 1
sDataCorr = Replace(DataEstrazioneDL(idEstr),".","/")
sRecord = FormatSpace(nProgr,9,True) & sChrSep
sRecord = sRecord & FormatSpace(IndiceAnnualeDL(idEstr),5,True) & sChrSep
' sRecord = sRecord & IndiceMensileDL(idEstr) & sChrSep
sRecord = sRecord & sDataCorr & sChrSep
For e = 1 To 20
sRecord = sRecord & Format2(aNum(e)) & sChrSep
Next
sRecord = RimuoviLastChr(sRecord,sChrSep)
Call ScriviFile(sFile,sRecord,False,True)
Else
Exit For
End If
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(nEstrInizio,nEstrFine,k)
Next
Call CloseFileHandle(sFile)
' Call LanciaFile(sFile)
Scrivi "Esportato file " & sFile
MsgBox "Fine",vbInformation
End Sub
Function AddSlash(s)
If Right(s,1) <> "\" Then
AddSlash = s & "\"
Else
AddSlash = s
End If
End Function
