x luigib chiarimenti

[keeper]

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?

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
 

[LuigiB]

ciao Kepper , incollacome si deve lo script e poi se ne riparla...

[Baffoblu]

Keeper...keeper, ma proprio al "maestro" dovevi postare
uno script così ?
Lo sai che lui ci tiene che noi impariamo !

Avanti te lo detto e fatto vedere non so più quante volte come si fa.
poi ci sono anche le guide etc....

Capisci che così lo script non si può utilizzare ?

Chi vorrebbe aiutarti, si troverebbe costretto a dover
ricomporre lo script pezzo per pezzo, rimettere le parole
chiave nei punti giusti, le variabili, tutto.
Per farlo ci vuole un bel po di tempo, sopratutto se lo script
è abbastanza lungo.....

Prova a copiare quello che hai postato e mettilo nel programma
spaziometria e poi anche se premi il pulsante "autoformattazione"
vedrai che non servirà a nulla, BISOGNA fare tutto manualmente.
Capisci cosa intendo ?

SIA BEN CHIARO, mica ti sto sgridando o offendendo, ma ti sto
aiutando....

Pensa.... se Luigi vedeva lo script postato come si deve
invece di riponderti come ha giustamente fatto
ti avrebbe AIUTATO........

[keeper]

ciao Kepper , incollacome si deve lo script e poi se ne riparla...

ciao scusa ma per la fretta non avevo vistoche nell'incollare lo script avav perso la formattazione
x baffo lo so devo fare attenzione.

[LuigiB]

Ciao Keeper ecco lo script che ora funziona , per le sorti che dici ci vuole troppo temp di elaborazione quidi sebbene si possa fare non te lo consiglio

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
	Call CloseFileHandle (sFile)
	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(5)
	aVoci(0) = "Estratto"
	aVoci(1) = "Ambo"
	aVoci(2) = "Terno"
	aVoci(3) = "Quaterna"
	aVoci(4) = "Cinquina"
	aVoci(5) = "Sestina"
	


	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

[keeper]

ok grazie luigi hai effettuato anche la modifica attennderò l'elaborazone

[LuigiB]

si ma comunque il carico di lavoro è sempre elevato

[keeper]

ok gentilissimo

[claudio8]

x keeper chi troppo aspetta ..... non va di fretta.

Ciao

[keeper]

ciao luigib ma il file che utilizza lo script è quello nella sezione base dati? perchè non comprende tutte le estrazioni? o è solo quello che ho io sul mio computer sballato?