Io ho adottato il suggerimento di Luigi, che saluto....a me funziona
Option Explicit
Sub Main
Dim aLunghette,nQuantitaLung,nClasseFormazione
Dim aRuote,nSorte
Dim Inizio,Fine
Inizio = EstrazioneIni
Fine = EstrazioneFin
nQuantitaLung = AlimentaArrayLunghette(aLunghette)
If nQuantitaLung >= 2 Then
If VerificaDoppi(aLunghette) Then
nClasseFormazione = Int(InputBox("Quanti numeri per ogni formazione in gioco da 2 a " & nQuantitaLung))
Call ScegliRuote(aRuote)
nSorte = ScegliEsito(2,2,nClasseFormazione)
If nClasseFormazione >= 2 And nClasseFormazione <= nQuantitaLung Then
Call ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,Fine)
Else
MsgBox "Quantità errata",vbExclamation
End If
End If
Else
MsgBox "Lunghette insufficient",vbExclamation
End If
End Sub
Function VerificaDoppi(aLunghette)
Dim k,j,n,sNumeriNonValidi,sNumeriDoppi
ReDim aB(90)
sNumeriNonValidi = ""
sNumeriDoppi = ""
For k = 1 To UBound(aLunghette)
For j = 1 To UBound(aLunghette(k))
n = Int(aLunghette(k)(j))
If n > 0 And n <= 90 Then
If aB

Then
sNumeriDoppi = sNumeriDoppi & " Lunghetta " & k & " numero " & n & ","
Else
aB

= True
End If
Else
sNumeriNonValidi = sNumeriNonValidi & " Lunghetta " & k & " numero " & n & ","
End If
Next
Next
If sNumeriNonValidi <> "" Or sNumeriDoppi <> "" Then
If sNumeriNonValidi <> "" Then
MsgBox "Numeri non validi " & vbCrLf & sNumeriNonValidi,vbExclamation
End If
If sNumeriDoppi <> "" Then
MsgBox "Numeri ripetuti " & vbCrLf & sNumeriDoppi,vbExclamation
End If
VerificaDoppi = False
Else
VerificaDoppi = True
End If
End Function
Function AlimentaArrayLunghette(aLunghette)
' per comodita le lunghette sono preimpostate ma nulla vieta di leggerle da un file o da inputbox
ReDim aLunghette(5)
aLunghette(1) = Split("0,66,67,69,78,72,89",",") ' 6
aLunghette(2) = Split("0,55,57,59,75,77,86",",") ' 6
aLunghette(3) = Split("0,65,68,79,88",",") '4
aLunghette(4) = Split("0,50,58,54,70,87",",") '5
aLunghette(5) = Split("0,56,52,76,85",",") '4
' la funzione torna il numero di lunghette ( l'elemento a indice 0 non è usato)
AlimentaArrayLunghette = UBound(aLunghette)
End Function
Sub ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,fine)
Dim I
Dim k,aRetColonna,sLungUsate
Dim aT
aT = Array("","Formazione","Ritardo","Frequenza","RitardoMax")
Call InitTabella(aT)
ReDim aN(UBound(aLunghette))
For k = 1 To UBound(aN)
aN(k) = k
Next
ReDim aSegni(nClasseFormazione)
Call InitSviluppoIntegrale(aN,nClasseFormazione)
Do While GetCombSviluppo(aRetColonna)
sLungUsate = ""
For k = 1 To nClasseFormazione
aSegni(k) = aLunghette(aRetColonna(k))
sLungUsate = sLungUsate & aRetColonna(k) & "-"
Next
Call Messaggio("Sviluppo colonne tra le lunghette " & RimuoviLastChr(sLungUsate,"-"))
Call SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,fine)
If ScriptInterrotto Then Exit Do
DoEventsEx
Loop
Call Scrivi(String(50,"="))
Call Scrivi("Colonne sviluppate : " & I)
Call Scrivi("Classe : " & nClasseFormazione)
Call Scrivi("Sorte : " & nSorte)
Call Scrivi("Ruote : " & StringaRuote(aRuote))
Call Scrivi(String(50,"="))
Call Scrivi
Call CreaTabellaOrdinabile(2)
End Sub
Sub SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,Fine)
Dim nClasse,K,aTmp,nPnt
Dim nRitardo,nRitardoMax,nFrequenza
ReDim aT(4)
nClasse = UBound(aSegni)
ReDim aColonna(nClasse)
ReDim aPuntatore(nClasse)
ReDim aQSegni(nClasse)
For K = 1 To nClasse
aTmp = aSegni(K)
aPuntatore(K) = 1
aQSegni(K) = UBound(aTmp)
Next
nPnt = nClasse
Do
For K = 1 To nClasse
aTmp = aSegni(K)
aColonna(K) = aTmp(aPuntatore(K))
Next
I = I + 1
' Call Scrivi(FormatSpace(I,4,True) & ") " & StringaNumeri(aColonna))
Call StatFrzTurbo(aColonna,aRuote,nSorte,nRitardo,nRitardoMax,0,nFrequenza,,Inizio,Fine)
aT(1) = StringaNumeri(aColonna)
aT(2) = nRitardo
aT(3) = nFrequenza
aT(4) = nRitardoMax
Call AddRigaTabella(aT)
Do While aPuntatore(nPnt) + 1 > aQSegni(nPnt)
nPnt = nPnt - 1
If nPnt = 0 Then Exit Do
Loop
If nPnt > 0 Then
aPuntatore(nPnt) = aPuntatore(nPnt) + 1
For K = nPnt + 1 To nClasse
aPuntatore(K) = 1
Next
nPnt = nClasse
End If
If ScriptInterrotto Then Exit Do
DoEventsEx
Loop While nPnt > 0
End Sub