L
LuigiB
Guest
ciao Cinzia , ecco la mia soluzione , in pratica date la quantita di lunghette voluta ciascuna con una certa quantita di numeri anche differente sviluppa tutte le combinazioni della classe voluta prendendo massimo un numero da ciascuna lunghetta di base,
Lo script è dinamico quindi se cambi le lunghette funziona lo stesso (almeno nell'ipotesi fai varie prove).
tutto si fonda sulla sub SviluppaColonne che riceve in input le lunghette da cui prendere i numeri da combinare e sviluppa le colonne similmente a come si sviluppano nel tototcalcio prendendo un segno per ognuna delle posizioni possibili fino a coprire tutte le combinazioni).
Noi abbiamo un primo insieme di X lunghette (nel caso specifico dell'esempio 4) , facciamo che vogliamo svilupparle in ambi (è dinamico puoi scegliere la classe che vuoi) allora lo script crea tutti gli ambi che si formano con 4 lunghette che in parole povere stanno a dire
prendi la prima e la seconda lunghetta e combina i numeri facendo uscire ovviamente degli ambi , poi prendi la prima e la terza e fai la stessa cosa , poi prendi la prima e la quarta e ripeti e cosi via fino a che non si arriva alla lunghetta terza e quarta che è l'ultima delle possibili combinazioni tra le lunghette.
Ogni combinazione di lunghette quindi vine passata alla funzione SviluppaColonne
Lo script è dinamico quindi se cambi le lunghette funziona lo stesso (almeno nell'ipotesi fai varie prove).
tutto si fonda sulla sub SviluppaColonne che riceve in input le lunghette da cui prendere i numeri da combinare e sviluppa le colonne similmente a come si sviluppano nel tototcalcio prendendo un segno per ognuna delle posizioni possibili fino a coprire tutte le combinazioni).
Noi abbiamo un primo insieme di X lunghette (nel caso specifico dell'esempio 4) , facciamo che vogliamo svilupparle in ambi (è dinamico puoi scegliere la classe che vuoi) allora lo script crea tutti gli ambi che si formano con 4 lunghette che in parole povere stanno a dire
prendi la prima e la seconda lunghetta e combina i numeri facendo uscire ovviamente degli ambi , poi prendi la prima e la terza e fai la stessa cosa , poi prendi la prima e la quarta e ripeti e cosi via fino a che non si arriva alla lunghetta terza e quarta che è l'ultima delle possibili combinazioni tra le lunghette.
Ogni combinazione di lunghette quindi vine passata alla funzione SviluppaColonne
Codice:
Option Explicit
Sub Main
Dim aLunghette,nQuantitaLung,nClasseFormazione
nQuantitaLung = AlimentaArrayLunghette(aLunghette)
If nQuantitaLung >= 2 Then
nClasseFormazione = Int(InputBox("Quanti numeri per ogni formazione in gioco da 2 a " & nQuantitaLung))
If nClasseFormazione >= 2 And nClasseFormazione <= nQuantitaLung Then
Call ProduciFormazioni(aLunghette,nClasseFormazione)
Else
MsgBox "Quantità errata",vbExclamation
End If
Else
MsgBox "Lunghette insufficient",vbExclamation
End If
End Sub
Function AlimentaArrayLunghette(aLunghette)
' per comodita le lunghette sono preimpostate ma nulla vieta di leggerle da un file o da inputbox
ReDim aLunghette(4)
aLunghette(1) = Split("0,1,2,3",",")
aLunghette(2) = Split("0,4,5,6,7",",")
aLunghette(3) = Split("0,8,9",",")
aLunghette(4) = Split("0,10",",")
' la funzione torna il numero di lunghette ( l'elemento a indice 0 non è usato)
AlimentaArrayLunghette = UBound(aLunghette)
End Function
Sub ProduciFormazioni(aLunghette,nClasseFormazione)
Dim k ,aRetColonna ,sLungUsate
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)
If ScriptInterrotto Then Exit Do
DoEventsEx
Loop
End Sub
Sub SviluppaColonne (aSegni )
Dim nClasse , k , aTmp , nPnt
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
Call Scrivi (StringaNumeri (aColonna))
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
