keeper
Advanced Member >PLATINUM PLUS<
CIAO LUIGIB se lancio questo script perchè non funziona più con le ultime versioni di psaziometria?
poi volevo chiederti riesco a tirar fuori delle cinquine o sestine?
poi volevo chiederti riesco a tirar fuori delle cinquine o sestine?
Codice:
Class clsPresenze
Dim Presenze
Dim sNumeri
Dim Rit
Dim RitMax
End Class
Sub Main
Dim sFile
Dim idEstr
Dim sRecord
Dim nClasse
Dim k
Dim sKey
Dim clsPres
Dim collPres
Dim nTrovati
Dim aColonne
Dim aNumeri
nClasse = ScegliClasse
If nClasse <= 0 Then Exit Sub
sFile = GetDirectoryAppData & "Estrazioni10ELotto.txt"
Call EliminaFile(sFile)
Call Messaggio("Calcolo frequenza")
Set collPres = GetNewCollection
For idEstr = EstrazioneIni To EstrazioneFin
ReDim aColonna(0)
If GetColonna(idEstr,aColonna) Then
sRecord = FormatSpace(IndiceAnnuale(idEstr),5,True) & "|" & DataEstrazione(idEstr) & "|" & StringaNumeri(aColonna,"|")
Call ScriviFile(sFile,sRecord)
aColonne = SviluppoIntegrale(aColonna,nClasse)
For k = 1 To UBound(aColonne)
sKey = "k"
For j = 1 To nClasse
sKey = sKey & Format2(aColonne(k,j)) & "."
Next
If sKey <> "" Then
sKey = Left(sKey,Len(sKey) - 1)
Set clsPres = GetClsPres(sKey,collPres)
clsPres.Presenze = clsPres.Presenze + 1
End If
Next
End If
Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr)
If ScriptInterrotto Then Exit For
Next
ReDim aComb(100,2)
Call IsolaPiuFrequenti(collPres,aComb)
If ApriBaseDatiFT(sFile,20,"|") Then
Call Messaggio("Creo lista")
Call Scrivi("Elenco delle 100 combinazioni da " & nClasse & " numeri piu frequenti al 10 e lotto")
Call Scrivi
ReDim aTitoli(4)
aTitoli(1) = "Combinazione"
aTitoli(2) = "Frequenza"
aTitoli(3) = "Ritardo"
aTitoli(4) = "RitardoMax"
Call InitTabella(aTitoli)
k = 0
For k = 1 To UBound(aComb)
aNumeri = Split(aComb(k,2),".")
ReDim aV(4)
aV(1) = aComb(k,2)
aV(2) = aComb(k,1)
aV(3) = RitardoCombinazioneFT(aNumeri,nClasse)
aV(4) = SerieStoricoFT(1,EstrazioniArchivioFT,aNumeri,nClasse)
If aComb(k,1) > 0 Then
Call AddRigaTabella(aV)
End If
Call AvanzamentoElab(1,UBound(aComb),k)
If ScriptInterrotto Then Exit For
Next
Call CreaTabella(2,0,0,100)
Else
MsgBox "File estrazioni 10 e lotto non prodotto"
End If
End Sub
Function GetClsPres(sKey,collPres)
On Error Resume Next
Dim clsP
Set clsP = collPres(sKey)
If clsP Is Nothing Then
Set clsP = New clsPresenze
clsP.sNumeri = Mid(sKey,2)
clsP.Presenze = 0
collPres.Add clsP,sKey
End If
Set GetClsPres = clsP
End Function
Function GetColonna(idEstrazione,colonna)
Dim nInseriti
Dim Ruota,pos,n
Dim k,i
ReDim aCol(90)
ReDim colonna(20)
Do While nInseriti < 20 And pos <= 5
For pos = 1 To 5
For Ruota = 1 To 10
n = Estratto(idEstrazione,Ruota,pos)
If n > 0 Then
If aCol(n) = False Then
aCol(n) = True
nInseriti = nInseriti + 1
If nInseriti = 20 Then Exit For
End If
End If
Next
If nInseriti = 20 Then Exit For
Next
Loop
For k = 1 To 90
If aCol(k) Then
i = i + 1
colonna(i) = k
End If
Next
ReDim Preserve colonna(i)
If i = 20 Then
GetColonna = True
Else
GetColonna = False
End If
End Function
Function ScegliClasse()
ReDim aVoci(3)
aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"
ScegliClasse = ScegliOpzioneMenu(aVoci,2,"Secegli tipo combinazione") + 1
End Function
Sub IsolaPiuFrequenti(collPres,aComb)
Dim k,j,i
Dim clsPres
Call Messaggio("Selezione combinazioni piu frequenti")
ReDim aComb(100,2)
For k = 1 To UBound(aComb)
aComb(k,1) = 0
aComb(k,2) = ""
Next
i = 0
For Each clsPres In collPres
For k = 1 To UBound(aComb)
If clsPres.presenze >= aComb(k,1) Then
For j = UBound(aComb) To(k + 1) Step - 1
aComb(j,1) = aComb(j - 1,1)
aComb(j,2) = aComb(j - 1,2)
Next
aComb(k,1) = clsPres.presenze
aComb(k,2) = clsPres.snumeri
Exit For
End If
Next
i = i + 1
Call AvanzamentoElab(1,collPres.count,i)
If ScriptInterrotto Then Exit For
Next
End Sub
[B][SIZE=2][COLOR=#0000c0][SIZE=2][COLOR=#0000c0]
[/COLOR][/SIZE][/COLOR][/SIZE][/B]
Ultima modifica:
