salve,
utile precisazione
...si tratta di "Combinazione" di N elementi a gruppi di K e non di "Permutazione"...
il file che mi hai indicato contiene delle macro che per alcune linee
mi risultano di difficile interpretazione al momento.
mi sono ricordato che tempo addietro ho visto credo una tua macro, non ricordo il topic nè
l'argomento, che faceva uso di un ciclo while...wend;
così mi sono studiato un pò tale ciclo ed ho risolto il problema in questo semplice modo:
per ottenere gli accoppiamenti del tipo 12, 13, 14, ...ho usato questa macro:
- Codice: Seleziona tutto
Sub Ambi()
RngIni = Range("A" & Rows.Count).End(xlUp).Row
If RngIni = 1 Then
RngIni = RngIni + 1
End If
Range("A3:E" & RngIni).ClearContents
y = 1 'colonna
x = 3 'riga
i = 1 'colonna
While Cells(1, i) <> ""
j = i + 1
While Cells(1, j) <> ""
Cells(x, y) = (Cells(1, i)) & (Cells(1, j))
Cells(x, y).Interior.ColorIndex = 3 'ROSSO
y = y + 1
If y = 6 Then
x = x + 1
y = 1
End If
j = j + 1
Wend
i = i + 1
Wend
Application.ScreenUpdating = True
End Sub
per ottenere gli accoppiamenti del tipo 21, 31, 41,...
ho semplicemente invertito gli indici, per cui ne viene fuori questa macro:
- Codice: Seleziona tutto
Sub AmbiINV()
Application.ScreenUpdating = False
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("A3:E" & UR).ClearContents
y = 1 'colonna
i = 1 'colonna
While Cells(1, i) <> ""
j = i + 1
While Cells(1, j) <> ""
Cells(UR + 1, y) = (Cells(1, j)) & (Cells(1, i))
Cells(UR + 1, y).Interior.ColorIndex = 4 'VERDE
y = y + 1
If y = 6 Then
UR = UR + 1
y = 1
End If
j = j + 1
Wend
i = i + 1
Wend
Application.ScreenUpdating = True
End Sub
non saranno il massimo in termini di struttura e velocità,
per un numero elevato di combinazioni, ma funziona.
grazie e saluti