[Excel 2003] Combinazioni con ripetizioni senza permutazioni

[recalcatiiti]

Buonasera a tutti,

Mi piacerebbe poter generare le combinazioni di n=6 numeri di classe k (max 6) considerando la possibilità di ripetere le singole cifre, ma escludendo tutte le permutazioni.

L'esempio di seguito chiarisce quanto scritto sopra.

Le combinazioni che cerco per n=6 e k=2 sono le seguenti:

11
21
22
31
32
33
41
42
43
44
51
52
53
54
55
61
62
63
64
65
66

Cercando nel forum ho trovato questa discussione:

http://www.pc-facile.com/forum/viewtopic.php?t=88953

La macro proposta da Flash potrebbe andare bene senonché questa considera le permutazioni delle combinazioni e funziona fino a k=3.

Qualcuno a qualche idea? Vi ringrazio molto tutti in anticipo.

sr

[wallace&gromit]

ciao,
a partire dalla macro di flash da te citata ho costruito questa, che crea le combinazioni con n = 6 e k = 6.
La variabile n è inserita come UR, al suo posto si può inserire qualsiasi numero.
Non sono riuscito invece per ora a rendere la variabile k e comunque la macro si presta a parecchi miglioramenti, vediamo se troviamo aiuto nel forum.

Codice: Seleziona tutto

Sub Cambinaz2()
UR = 6
URE = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Range("A2:A" & URE).ClearContents
For RRA = 1 To UR
    For RRB = 1 To UR
    If RRB < RRA Then GoTo salta1
        For RRC = 1 To UR
        If RRC < RRB Then GoTo salta2
        For RRD = 1 To UR
        If RRD < RRC Then GoTo salta3
        For RRE = 1 To UR
        If RRE < RRD Then GoTo salta4
        For RRF = 1 To UR
        If RRF < RRE Then GoTo salta5
            Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = RRA & RRB & RRC & RRD & RRE & RRF
salta5:
        Next RRF
salta4:
        Next RRE
salta3:
        Next RRD
salta2:
        Next RRC
salta1:
    Next RRB
Next RRA
End Sub

[Anthony47]

Vedi la macro proposta da w&g, sopra.

Io invece riciclerei quanto suggerito all'utente carlo.footballer qui: viewtopic.php?f=26&t=96371&p=613359#p613359

Per rispondere alla domanda di escludere "tutte le permutazioni" (meglio descritta nel tuo esempio) va modificato il codice della Sub PopWk, come segue:

Codice: Seleziona tutto

Sub PopWk(ByVal Dummy)
Dim myExc As Boolean
'
For i = 1 To UBound(wIndx, 1)
    If i > 1 Then If WKArr(myCnt, i - 1) < VArr(1, wIndx(i)) Then myExc = True
    WKArr(myCnt, i) = VArr(1, wIndx(i))
    If myExc = True Then Exit For
Next i
If myExc = False Then myCnt = myCnt + 1
End Sub


Leggi comunque quanto gia' scritto nel messaggio che ti ho linkato prima.
La macro da eseguire e' la Sub reComb.
Gli elementi da combinare vanno scritti in Foglio1 B2:T2, la Classe desiderata va scritta in B3; le informazioni effettive vengono calcolate in C6:C8.
Le combinazioni vengono scritte in Foglio2-A1, ma la destinazione puo' essere modificata nel codice (vedi istruzioni marcate <<<).
Per funzionare correttamente i dati in B2:T2 devono essere "crescenti"; es:
-A B C D E ....
-a b c d e ...
-1 2 3 4 5 6 7 8 9 10 11 ...
-1 2 3 4 5 6 7 8 9 A B C D ...
-1 2 3 4 5 6 7 8 9 a b c d ...
NON sono crescenti lettere Maiuscole e minuscole intercalate e ..tutte le altre combinazioni che scoprirete da voi

La macro proposta all'utente carlo.footballer consentiva invece di inserire qualsiasi valore nell'elenco da combinare, tipo Mela Arancia Fragola Limone.
Nel caso di elenchi molto lunghi (oltre 500K righe) la macro richiedera' parecchi secondi per essere completata; e' presente una form che consente di conoscere lo stato di avanzamento del calcolo ed eventualmente interrompere il processo, ma il calcolo dell'orario di completamento e' impreciso (la precisione aumenta man mano che si procede), ma

Il mio file dimostrativo e' qui: https://www.dropbox.com/s/dw8ros1rp9fm1 ... .xlsm?dl=0

Rispetto alla macro di w&g, questa soluzione gestisce anche piu' di 9 elementi da combinare, e la classe e' impostabile sul foglio.

E' il mio ultimo messaggio del 2015, quindi Buon anno a tutti.

[recalcatiiti]

Ciao a tutti,

Grazie mille w&g e Anthony siete inestimabili. Vi auguro buone feste e buon'anno a voi ed ai vostri cari. Continuate così, un caro saluto,

sr