Module MyScript
Public Sub MyScriptRoutine()
' SCRIVERE QUI IL PROPRIO CODICE COME SE FOSSE LA SUB MAIN DI SPAZIOMETIRA
Dim aR(11) As Long, idMese As Long = 3, ord As Long = -1
Dim R As Long
For R = 1 To 11
aR(R) = R
Next
Call GetEstrattiSuRuotaSingola(aR(), idMese, ord)
End Sub
Sub GetEstrattiSuRuotaSingola(aR() As Long, idMese&, ord&)
Dim idEstr&, idM&, s$, pres&, nR&
nR = UBound(aR)
Dim r As Long, p As Long, E As Long, id As Long
' per utilizzare matrice a 2 dimensioni sostituisco aStat(nR,90,14)
ReDim aStat(nR * 90, 14) As Long
ReDim aId(nR, 90) As Long
GetIdAppoggio(aR(), aId(), aStat()) ' questa funzione mi restituisce l indice del vettore dove coolocare i risultati
For idEstr = 1 To EstrazioniArchivio
idM = Month(DataEstrazione(idEstr))
For r = 1 To UBound(aR)
ReDim aE(5) As Long
Call GetArrayNumeriRuota(idEstr, aR(r), aE)
If aE(1) > 0 Then
For p = 1 To 5
E = aE(p)
id = aId(r, E)
aStat(id, idM) = aStat(id, idM) + 1
Next
End If
Next
Next
'Esempio 1
Call OrdinaMatriceL(aStat, idMese, ord)
' esempio 2
'Call OrdinaStat(aStat, idMese, ord)
For id = 1 To UBound(aStat)
s = SiglaRuota(aStat(id, 13)) & " " & Format2(aStat(id, 14)) & " "
For E = 1 To 12
s = s & Format2(aStat(id, E)) & " "
Next
Scrivi s
Next
End Sub
' arte dell arrangiamento dell accademia pasticcioni
Sub GetIdAppoggio(aRu() As Long, aId() As Long, aStat() As Long)
Dim i As Long, n As Long, k As Long
For i = 1 To UBound(aRu)
For n = 1 To 90
k + = 1
aId(i, n) = k
aStat(k, 13) = aRu(i)
aStat(k, 14) = n
Next
Next
End Sub
Sub OrdinaStat(aN() As Long, idC As Long, V As Long)
Dim lb As Long:lb = 1
Dim ub As Long:ub = UBound(aN)
Dim i As Long
Dim j As Long
If V = -1 Then
Do While lb < ub
For i = ub To lb + 1 Step -1
If aN(i, idC) > aN(i - 1, idC) Then
For j = 0 To UBound(aN, 2)
Scambia aN(i, j), aN(i - 1, j)
Next
End If
Next
lb = lb + 1
Loop
ElseIf V = 1 Then
Do While lb < ub
For i = ub To lb + 1 Step -1
If aN(i, idC) < aN(i - 1, idC) Then
For j = 0 To UBound(aN, 2)
Scambia aN(i, j), aN(i - 1, j)
Next
End If
Next
lb = lb + 1
Loop
End If
End Sub
Sub Scambia(a As Long, b As Long)
Dim t As Long = a
a = b
b = t
End Sub
End Module
