'tom's bakery script n. 29 x million day - lo script consente di analizzare e ordinare con tabella excel opzionale formazioni di varia classe per rit, fq incmax e ind conv. x tutte le sorti. By magia rivisto e leggerissimamente modificato by me.
Option Explicit
Dim clsHSS,clsSvil
Sub Main
Dim aCombMigliori(100,06)
Dim sFileArchivio : sFileArchivio = ScegliFile(".\") 'GetDirectoryAppData & "Archivio MillionDAY\MillionDay-aggiornamento-aggiornato-ultima-estrazione_ordinato.txt"
If ApriBaseDatiFT(sFileArchivio,05,",",55) Then
Set clsHSS = CreateObject("HSS.ClsHighSpeedStat") : Call clsHSS.Init(sFileArchivio,09,",",05)
Set clsSvil = GetMotoreSviluppoIntegrale
Dim nGaranzia : nGaranzia = ScegliSorte
Dim idValoreDaAna,sValoreUsato : idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
Dim nClasse : nClasse = ScegliClasse : ResetTimer
Dim nInizio,nFine : nInizio = 00001 : nFine = EstrazioniArchivioFT
If nClasse > 00 And nGaranzia > 00 And nGaranzia <= nClasse And idValoreDaAna > 00 Then
Dim CombTot : CombTot = InitSviluppaComb(nClasse)
ReDim aCol(nClasse)
Do While clsSvil.GetCombSviluppo(aCol) = True
Call AnalisiComb(aCol,nGaranzia,aCombMigliori,nInizio,nFine,idValoreDaAna)
Dim k : k = k + 01
If k Mod 20 = 00 Then
Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
Call AvanzamentoElab(01,CombTot,k) : If ScriptInterrotto Then Exit Do
End If
Loop
Dim nEnd : nEnd = Timer : Call Messaggio(" Creazione Tabella ") : Call GetTitoli()
Call Scrivi("Numero Combinazioni: " & CombTot & " sviluppate in classe ( " & nClasse & _
" - " & NomeSorte(nClasse) & " ) analizzate per punti ( " & nGaranzia & " - " & _
NomeSorte(nGaranzia) & " )",01,01,,01,04,,01)
Call Scrivi("La seguente lista mostra le prime 100 combinazioni in base al valore di " & _
sValoreUsato,01,01,,01,04,,01)
Call Scrivi("Range analizzato " & GetInfoEstrazioneFT(nInizio) & " fino a " & _
GetInfoEstrazioneFT(nFine),01,01,,01,04,,01)
Call Scrivi("Estrazioni analizzate totali : " &(EstrazioniRicercaFT),01,01,,01,04,,01)
Call Scrivi("Tempo di elaborazione : " & TempoTrascorso,01,01,,01,04,,01)
Call Scrivi() : Call GetDati(k,aCombMigliori) : Call ScegliTabella()
Else
Call MsgBox(" Selezionare la classe di sviluppo e la garanzia ," & _
"si ricorda che la garanzia non puo essere maggiore della classe di sviluppo" & _
"e che bisogna scegliere quale valore statistico considerare per" & _
"alimentare la lista delle prime 100 Combinazioni ")
End If
End If
End Sub
Sub AnalisiComb(aNum,Garanzia,aCombMig,nInizio,nFine,idValoreDaAna)
Dim Valore,RetFre,RetRit,RetRitMax,RetIncrRitMax,k,j
Dim nTot : nTot = EstrazioniArchivioFT
Call clsHSS.StatisticaFormazioneTxt(aNum,Garanzia,RetRit,RetRitMax,RetIncrRitMax,RetFre,nInizio,nFine)
Dim RetIndConv : RetIndConv = Round((RetFre / nTot) * RetRit,02)
Select Case idValoreDaAna
Case 01 : Valore = RetFre
Case 02 : Valore = RetRit
Case 03 : Valore = RetRitMax
Case 04 : Valore = RetIncrRitMax
Case 05 : Valore = RetIndConv
End Select
For k = 01 To UBound(aCombMig)
If Valore >= aCombMig(k,00) Then
For j = UBound(aCombMig) To(k + 01) Step - 01
aCombMig(j,00) = aCombMig(j - 01,00) : aCombMig(j,01) = aCombMig(j - 01,01)
aCombMig(j,02) = aCombMig(j - 01,02) : aCombMig(j,03) = aCombMig(j - 01,03)
aCombMig(j,04) = aCombMig(j - 01,04) : aCombMig(j,05) = aCombMig(j - 01,05)
aCombMig(j,06) = aCombMig(j - 01,06)
Next
aCombMig(k,00) = Valore : aCombMig(k,01) = RetFre : aCombMig(k,02) = RetRit
aCombMig(k,03) = RetRitMax : aCombMig(k,04) = RetIncrRitMax : aCombMig(k,05) = RetIndConv
aCombMig(k,06) = StringaNumeri(aNum,,True)
Exit For
End If
Next
End Sub
Sub GetDati(k,aCombMigliori)
For k = 01 To UBound(aCombMigliori)
Dim ADati :ADati = Array(ADati,aCombMigliori(k,06),aCombMigliori(k,01),aCombMigliori(k,02),_
aCombMigliori(k,03),aCombMigliori(k,04),aCombMigliori(k,05)) : Call AddRigaTabella(ADati)
Next
Set clsHSS = Nothing
End Sub
Function InitSviluppaComb(Classe)
ReDim aNum(0)
Call ScegliNumeri(aNum)
Dim k ',aNum(55) :
For k = aNum(0) To UBound(aNum) : Next
InitSviluppaComb = clsSvil.InitSviluppoIntegrale(aNum,Classe)
End Function
Function ScegliSorte()
Dim i,aVoci(05) : For i = 01 To 05 : aVoci(i) = NomeSorte(i) : Next
ScegliSorte = ScegliOpzioneMenu(aVoci,02," Seleziona Sorte da Analizzare ")
End Function
Function ScegliClasse()
Dim i,aVoci(05) : For i = 01 To 05 : aVoci(i) = NomeSorte(i) : Next
ScegliClasse = ScegliOpzioneMenu(aVoci,02," Seleziona Classe sviluppo ")
End Function
Function ScegliValoreDaAnalizzare(sValore)
Dim aVoci : aVoci = Array(aVoci,"Frequenza","Ritardo","Ritardo Massimo","Incr.Rit.Max.","Indice di Convenoenza")
Dim i : i = ScegliOpzioneMenu(aVoci,01," Quale valore considerare per l'ordinamento ? ")
sValore = aVoci(i)
ScegliValoreDaAnalizzare = i
End Function
Sub GetTitoli()
Dim aTitoli : aTitoli = Array(aTitoli,"Combinazione","Frequenza","Ritardo","Ritardo Max.","Incr.Rit.Max","Ind.Con")
Call InitTabella(aTitoli,01,,,05)
End Sub
Function ScegliTabella()
Dim aVoci : aVoci = Array(aVoci,"Tabella Normale","Tabella Ordinabile")
ScegliTabella = ScegliOpzioneMenu(aVoci,02," Seleziona Tipo Tabella ")
If ScegliTabella = 01 Then Call CreaTabella()
If ScegliTabella = 02 Then Call CreaTabellaOrdinabile()
End Function
ut
