Ciao carlo.footballer, benvenuto nel forum.
Hai fatto male ad accodarti a una discussione cosi' vecchia e comunque diversa dal tuo quesito; infatti il tuo messaggio e' passato "quasi" inosservato.
Non sono un fin statistico, ma si sembra strano che combinando 9 elementi a gruppi di 4 con ripetizioni si debbano ottenere 495 combinazioni; a me sembra che siano 9*9*9*9, cioe' 6561...
Comunque nella mia interpretazione il tutto si puo' sviluppare con questo codice:
- Codice: Seleziona tutto
Dim WKArr(), VArr, wIndx() As Long, myCnt As Long, myGrp As Long
Sub reComb()
Dim myList As Range, listCnt As Long, myDest As Range, hMany As Long
Set myList = Sheets("Foglio2").Range("B2:M2") '<<< L'area ORIZZONTALE con i valori da combinare
Set myDest = Sheets("Foglio3").Range("a1") '<<<2 L'area in cui sara' creata la nuova lista (Vedi Testo)
myGrp = 0 '<<< La classe delle combinazioni; 0 = "massima"
'
mystart = Timer: [O1] = mystart
hMany = Application.WorksheetFunction.CountA(myList)
If myGrp = 0 Then myGrp = hMany 'adatta myGRP
If myGrp > hMany Then myGrp = hMany
'
myDest.Resize(Rows.Count - myDest.Row - 5, myGrp + 1).ClearContents
listCnt = hMany 'myList.Count
expline = listCnt ^ myGrp
If expline > 1000000 Then
rispo = MsgBox("Saranno calcolate solo 1Mill di linee, invece di " & Format(expline / 1000000, "0.00") & "Mill" & vbCrLf _
& "Premere Ok per Continuare, Annulla per Abortire", vbOKCancel)
If rispo <> vbOK Then Exit Sub
expline = 1000000
End If
ReDim WKArr(1 To (expline) + 1, 1 To listCnt)
ReDim wIndx(1 To myGrp)
VArr = myList.Cells(1, 1).Resize(1, listCnt).Value
myCnt = 1
Call Recur(1, listCnt, 1)
myDest.Resize(myCnt + 10000, myGrp + 1).ClearContents
myDest.Resize(myCnt, myGrp) = WKArr
[O2] = Timer
MsgBox ("Completato, (h:m:s): " & Format((Timer - mystart) / 24 / 3600, "hh:mm:ss"))
End Sub
Sub Recur(ByVal Iniz As Integer, ByVal Final As Integer, ByVal myLevel As Integer)
Dim myI As Integer, myK As Integer
'
If myCnt >= 1000000 - 5 Then GoTo fEnd
For myK = 1 To Final
DoEvents
wIndx(myLevel) = wIndx(myLevel) + 1
If wIndx(myLevel) > Final Then wIndx(myLevel) = 1
If myLevel = myGrp - 0 Then '4
For myI = Iniz To Final
Call PopWk
wIndx(myLevel) = wIndx(myLevel) + 1
Next myI
wIndx(myLevel) = 0
flexit = True
Else
Call Recur(1, Final, myLevel + 1)
End If
If flexit = True Then Exit For
Next myK
fEnd:
End Sub
Sub PopWk()
'
For I = 1 To UBound(wIndx, 1)
WKArr(myCnt, I) = VArr(1, wIndx(I))
Next I
myCnt = myCnt + 1
End Sub
Va inserito tutto in un nuovo "modulo" del vba; per questo, partendo da Excel:
Da excel: Alt-F11 per aprire l' editor delle macro; Menu /Inserisci /Modulo; copia il codice e incollalo nel frame di dx.
Personalizza le righe marcate <<< come da tua situazione; ricorda che nell'area myList solo le celle compilate saranno prese in considerazione, e se myGrp (la classe di combinazioni) viene tenuta a "0" allora la classe sara' impostata pari al numero di elementi.
Quando sei pronto manda in esecuzione la Sub reComb; da Excel: Alt-F8 per avere l' elenco delle macro disponibili, seleziona reComb e premi Esegui.
Il mio file e' reperibile qui:
https://www.dropbox.com/s/ha66hjhd1ghu9 ... .xlsm?dl=0Nota che l' area in cui verranno scritte le combinazioni e' di dimensioni non prevedibile; quindi ti suggerisco di non inserire tue informazioni nelle stesse colonne.
Ciao, fai sapere se il tutto e' di qualche utilita'.