Script di Luigi-spaziometria

[houdini]

Luigi
ti chiedo se riesci e se e' possibile a immettere oltre la freguenze anche i ritardi x ambata e ambo delle formazioni elencate in questo tuo script .
Ti ringrazio
ciao



Option Explicit
Sub Main
Dim k,nClasse,nQElem , nIdColOrd
Dim RitM,FrqM
Dim Inizio,Fine , nQRuote
Dim sFrz,nSorte
ReDim aRetElementi(0)
ReDim aRuote(0)

Inizio = EstrazioneIni
Fine = EstrazioneFin
sFrz = ScegliFrz
nSorte = ScegliSorte
nIdColOrd = ScegliOrdinamento

nQRuote = ScegliRuote(aRuote)

If sFrz <> "" And nSorte > 0 And nQRuote > 0 Then

nClasse = GetClasseFormazione(sFrz)
nQElem = GetQElemFormazione(sFrz)
If nClasse > nSorte Then

Scrivi "Analisi da : " & Inizio
Scrivi "Analisi a : " & Fine
Scrivi "Ruote : " & GetStringaRuote(aRuote)
Scrivi "Formazione : " & sFrz
Scrivi "Per sorte : " & nSorte




Call InizializzaTable
For k = 1 To nQElem
ReDim aN(0)
Call GetItemFormazione(sFrz,aN,k)
Call GetValoriMedi(aN,Inizio,Fine,aRuote,RitM,FrqM,nClasse,nSorte)
Call AddRigaTable (aN ,RitM,FrqM)
Next
Call CreaTabella ( nIdColOrd)
Else
Call Scrivi("La formazione ha un numero di elementi inferiore alla sorte scelta")
End If
Else
MsgBox "Parametri non validi"
End If
End Sub
Function ScegliSorte
ReDim aV(4)
Dim k,i
For k = 2 To 5
i = i + 1
aV(i) = k
Next
k = ScegliOpzioneMenu(aV,,"Scegli sorte")
If k >= 0 Then
ScegliSorte = Int(aV(k))
End If
End Function
Function ScegliOrdinamento
ReDim aV(2)
Dim k,i

aV(1) = "Ritardo Medio"
aV(2) = "Frequanza media"

k = ScegliOpzioneMenu(aV,,"Scegli ordinamento")
If k >= 0 Then
ScegliOrdinamento= k +1
End If
End Function
Function ScegliFrz
ReDim aFile(0)
Dim sDir
Dim k
sDir = GetDirectoryAppData & "formazioni\"
Call ElencoFileInDirectory(sDir,aFile,".frz")
k = ScegliOpzioneMenu(aFile,,"Scegli formazione")
If k >= 0 Then
ScegliFrz = aFile(k)
Else
ScegliFrz = ""
End If
End Function
Sub GetValoriMedi(aNumeriFrz,Inizio,Fine,aRuote,RitM,FrqM,nClasseFrz,nSorte)
Dim k,e
Dim nColTot
Dim Rit,Frq
Dim RitT,FrqT
Dim aCol
nColTot = Combinazioni(nClasseFrz,nSorte)
RitT = 0
FrqT = 0
aCol = SviluppoIntegrale(aNumeriFrz,nSorte)
For k = 1 To UBound(aCol)
ReDim aN(nSorte)
For e = 1 To nSorte
's = s & Format2(aCol(k,e)) & "-"
aN(e) = aCol(k,e)
Next
Call StatisticaFormazione(aN,aRuote,nSorte,Rit,0,0,Frq,Inizio,Fine)
RitT = RitT + Rit
FrqT = FrqT + Frq
Next
RitM = Dividi(RitT,nColTot)
FrqM = Dividi(FrqT,nColTot)
End Sub
Sub InizializzaTable
ReDim aV(3)

aV(1) = "Formazione"
aV(2) = "RitMedio"
aV(3) = "FreqMedia"

Call InitTabella (aV , vbCyan )
End Sub
Sub AddRigaTable (aN ,RitM,FrqM)
ReDim aV(3)

aV(1) = StringaNumeri(aN ,,True )
aV(2) = Round(RitM,3)
aV(3) = Round(FrqM ,3)

Call AddRigaTabella (aV ,,"right")


End Sub

Function GetStringaRuote(aRuote)

Dim k , s

For k = 1 To UBound(aRuote)
s = s & SiglaRuota(aRuote(k)) & "-"
Next

If s <> "" Then s = Left(s ,Len(s)-1)
GetStringaRuote = s
End Function

 

[LuigiB]

ciao , ho visto che lo script consente di selezionare la sorte da analizzare e mostra ritardo medio e frequenza media per quella sorte .. non capisco la tua richiesta
cioè a prescindere dal tipo di analisi che uno scieglie nella tabella devono comparire i ritardi per estratto e per ambo sempre e comunque ?

 

[houdini]

si' oltre il ritardo e freguenza media, sarebbe interessante avere sempre anche i ritardi d' ambata e ambo delle formazioni selezionate.

 

[LuigiB]

Option Explicit
Sub Main
	Dim k,nClasse,nQElem,nIdColOrd
	Dim RitM,FrqM
	Dim Inizio,Fine,nQRuote
	Dim sFrz,nSorte
	ReDim aRetElementi(0)
	ReDim aRuote(0)
	Dim nRitE  , nRitA
	
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	sFrz = ScegliFrz
	nSorte = ScegliSorte
	nIdColOrd = ScegliOrdinamento
	nQRuote = ScegliRuote(aRuote)
	If sFrz <> "" And nSorte > 0 And nQRuote > 0 Then
		nClasse = GetClasseFormazione(sFrz)
		nQElem = GetQElemFormazione(sFrz)
		If nClasse > nSorte Then
			Scrivi "Analisi da : " & Inizio
			Scrivi "Analisi a : " & Fine
			Scrivi "Ruote : " & GetStringaRuote(aRuote)
			Scrivi "Formazione : " & sFrz
			Scrivi "Per sorte : " & nSorte
			Call InizializzaTable
			For k = 1 To nQElem
				ReDim aN(0)
				Call GetItemFormazione(sFrz,aN,k)
				Call GetValoriMedi(aN,Inizio,Fine,aRuote,RitM,FrqM,nClasse,nSorte)
				Call GetRitardoEstrattoAmbo (aN,Inizio,Fine,aRuote, nRitE , nRitA )
				
				Call AddRigaTable(aN,RitM,FrqM , nRitE , nRitA )
			Next
			Call CreaTabella(nIdColOrd)
		Else
			Call Scrivi("La formazione ha un numero di elementi inferiore alla sorte scelta")
		End If
	Else
		MsgBox "Parametri non validi"
	End If
End Sub
Function ScegliSorte
	ReDim aV(4)
	Dim k,i
	For k = 2 To 5
		i = i + 1
		aV(i) = k
	Next
	k = ScegliOpzioneMenu(aV,,"Scegli sorte")
	If k >= 0 Then
		ScegliSorte = Int(aV(k))
	End If
End Function
Function ScegliOrdinamento
	ReDim aV(4)
	Dim k,i
	aV(1) = "Ritardo Medio"
	aV(2) = "Frequanza media"
	aV(3) = "Ritardo estratto"
	aV(4) = "Ritardo ambo"
	
	k = ScegliOpzioneMenu(aV,,"Scegli ordinamento")
	If k >= 0 Then
		ScegliOrdinamento = k + 1
	End If
End Function
Function ScegliFrz
	ReDim aFile(0)
	Dim sDir
	Dim k
	sDir = GetDirectoryAppData & "formazioni\"
	Call ElencoFileInDirectory(sDir,aFile,".frz")
	k = ScegliOpzioneMenu(aFile,,"Scegli formazione")
	If k >= 0 Then
		ScegliFrz = aFile(k)
	Else
		ScegliFrz = ""
	End If
End Function
Sub GetValoriMedi(aNumeriFrz,Inizio,Fine,aRuote,RitM,FrqM,nClasseFrz,nSorte)
	Dim k,e
	Dim nColTot
	Dim Rit,Frq
	Dim RitT,FrqT
	Dim aCol
	nColTot = Combinazioni(nClasseFrz,nSorte)
	RitT = 0
	FrqT = 0
	aCol = SviluppoIntegrale(aNumeriFrz,nSorte)
	For k = 1 To UBound(aCol)
		ReDim aN(nSorte)
		For e = 1 To nSorte
			's = s & Format2(aCol(k,e)) & "-"
			aN(e) = aCol(k,e)
		Next
		Call StatisticaFormazione(aN,aRuote,nSorte,Rit,0,0,Frq,Inizio,Fine)
		RitT = RitT + Rit
		FrqT = FrqT + Frq
	Next
	RitM = Dividi(RitT,nColTot)
	FrqM = Dividi(FrqT,nColTot)
End Sub
Sub  GetRitardoEstrattoAmbo (aN,Inizio,Fine,aRuote, nRitE , nRitA )
	 
	 
	 
	Call StatisticaFormazione(aN,aRuote,1, nRitE ,0,0,0,Inizio , Fine)
	
	Call StatisticaFormazione(aN,aRuote,2, nRitA ,0,0,0,Inizio , Fine)
	

End Sub 
Sub InizializzaTable
	ReDim aV(5)
	aV(1) = "Formazione"
	aV(2) = "RitMedio"
	aV(3) = "FreqMedia"
	aV(4) = "RitardoEstratto"
	aV(5) = "RitardoAmbo"
	Call InitTabella(aV,vbCyan)
End Sub
Sub AddRigaTable(aN,RitM,FrqM , nRitE , nRitA )
	ReDim aV(5)
	aV(1) = StringaNumeri(aN,,True)
	aV(2) = Round(RitM,3)
	aV(3) = Round(FrqM,3)
	aV(4) = nRitE
	aV(5) = nRitA 
	
	Call AddRigaTabella(aV,,"right")
End Sub
Function GetStringaRuote(aRuote)
	Dim k , s
	
	For k = 1 To UBound(aRuote)
		s = s & SiglaRuota(aRuote(k)) & "-"
	Next
	If s <> "" Then s = Left(s,Len(s) - 1)
	GetStringaRuote = s
End Function

 

[houdini]

ambi consecutivi e ambi integrali non funzionano .

 

[LuigiB]

sostituisci questa riga

If nClasse > nSorte Then

con quesst'altra

If nClasse >= nSorte Then

 

[houdini]

grazie