[VBA EXCEL] Controllo delle combinazioni rimanenti date quelle utilizzate

[rossofoco]

Buongiorno a tutti/e,

intanto mi presento...mi chiamo Amedeo e vi ho "utilizzato" molto ultimamente imparando tante cose! Quindi grazie!

Venendo al dunque, vorrei da voi un consiglio. La situazione è la seguente:

Ho un foglio Excel che riporta sulla prima colonna combinazioni di lunghezza diversa (da poter scegliere di volta in volta) delle lettere I,X. Posta ad esempio la lunghezza della "password" pari a 3 avremmo la seguente tabella

A B
1 IIX XII
2 XII XXII
3 III IXX
4 XXX IXI

Io vorrei con un clic, far apparire nella colonna B (per esempio) tutte le combinazioni rimanenti da poter utilizzare.
Il mio codice VB è il seguente:

Codice PHP:

[i]Sub Ovale1_Click()

Dim arrayChar() As String, arrayPwd() As String, lunghezza As Integer, Codcheck() As String
Dim a As Integer, numeroComb As Integer, varChar As String, pwd As String
Dim c As Integer, n As Integer, i As Integer
Dim break As Integer, break2 As Integer
Dim found As Boolean

numeroComb = 1
lunghezza = 3
varChar = "X,I"

'calcolo n° combinazioni
For i = 1 To lunghezza
numeroComb = numeroComb * 2
Next i

arrayChar = Split(varChar, ",")
Worksheets("Foglio1").Activate
Foglio1.Cells(1, 1).Activate
'calcolo del numero di celle non vuote
n = Application.WorksheetFunction.CountA(Range(Selection, Selection.End(xlDown)).EntireColumn)

ReDim Codcheck(n) As String
ReDim arrayPwd(numeroComb) As String

'ciclo per assegnare i valori dei codici all'array
For i = 0 To n
    Codcheck(i) = Foglio1.Cells(i + 2, 1).Value
Next i
break = 0
i = 0
a = 0

For c = 0 To numeroComb
 pwd = genera(arrayChar, lunghezza - 1)
 
            For i = 0 To n
            
                If Codcheck(i) = pwd Then
        
                            break1 = break1 + 1
                            Exit For
                            
                End If
                
                found = InStr(1, "" & Join(arrayPwd, "") & "", "" & pwd & "") > 0
                If found Then
                         break2 = break2 + 1
                End If
            Next i
               
                If break1 = 0 Then
                              If break2 = 0 Then
                                            arrayPwd(a) = pwd
                                            a = a + 1
                             End If
                End If
            break1 = 0
            break2 = 0
Next c

i = 1
a = 10
For i = 0 To numeroComb
    Foglio1.Cells(i + 1, a) = arrayPwd(i)
Next i

End Sub


Private Function genera(arr, num_cifre)
Dim b As Integer, k As Integer, numero As Integer, variabile As String
     numero = UBound(arr)
     Randomize
     For b = 0 To num_cifre
         k = Int((2 * Rnd))
         variabile = variabile & arr(k)
     Next
     genera = variabile
End Function[/i] 


L'unico problema che mi rimane è che non è detto che la funzione generativa dei codici a tre cifre generi effettivamente tutte le possibili combinazioni. Sapete aiutarmi?? Ve ne sarei infinitamente grato!!!

PS.

Sicuramente il codice non è ottimizzato.... abbiate pietà ma le mie conoscenze sono abbastanza basic!!!

[Daniels118]

Per favore, usa i tag code per formattare il codice.

La domanda non richiedeva di postare tutto, quello di cui hai bisogno è un algoritmo per generare combinazioni con ripetizione, trovi la versione VBA qui:
http://www.hwupgrade.it/forum/showthread.php?t=2084088

[rossofoco]

Ciao Daniels118,


grazie per la risposta!! Io però vorrei avere da voi un piccolo aiuto per capire come oltre a generare un array con le combinazioni di lunghezza K dei due elementi N, posso controllare quali di questi elementi non sono già stati utilizzati nella colonna A del mio foglio di lavoro. Questa parte di controllo mi sta risultando difficile da risolvere. Ogni aiuto sarebbe oro per me!!

Grazie mille,
Amedeo

[Daniels118]

Nella forma più semplice basta fare due loop annidati e selezionare dal primo array gli elementi che non trovi nel secondo:

risultato = ""
for i = 0 to ubound(arr1)
  trovato = false
  for j = 0 to ubound(arr2)
    if arr1(i) = arr2(j) then
      trovato = true
      exit for
    end if
  next j
  if not trovato then
    risultato = risultato & " " & arr1(i)
  end if
next i

[rossofoco]

Ciao a tutti,

sto utilizzando il codice gentilmente offerto da voi :

Questa la sub principale

Sub Ovale1_Click()
 
Dim N() As Variant
    N = Array("x", "i")
    Dim K As Byte
    K = 2
   
    Dim Comb As Collection
    Set Comb = CombinazioniSemplici(N, K)
   
    Dim i As Integer
    For i = 1 To Comb.Count
        Cells(i, 5).Value = (Comb(i))
    Next i
 
End Sub

Mentre questa la sub per calcolo delle combinazioni:

Public Function CombinazioniSemplici(arrayElementi() As Variant, dimensioneGruppo As Byte) As Collection
 
    Dim LC As New Collection
    If UBound(arrayElementi) = 0 Then
        Set CombinazioniSemplici = LC
    End If
    If dimensioneGruppo = 0 Or dimensioneGruppo > UBound(arrayElementi) Then
        Set CombinazioniSemplici = LC
    End If
 
    Dim aP() As Integer
    ReDim aP(dimensioneGruppo - 1)
    Dim i As Integer
    For i = 0 To UBound(aP)
        aP(i) = i
    Next i
    Dim j As Integer
    Dim C As String
    Dim cnt As Integer
    Do
        C = ""
        For i = 0 To UBound(aP)
            C = C & arrayElementi(aP(i))
        Next i
        LC.Add (C)
       
        cnt = 0
        For i = UBound(aP) To 0 Step -1
            If aP(i) = UBound(arrayElementi) - cnt Then
                cnt = cnt + 1
                If cnt = UBound(aP) + 1 Then Exit Do
            Else
                aP(i) = aP(i) + 1
                For j = 0 To UBound(aP)
                    If i < j Then aP(j) = aP(i) + (j - i)
                Next
                Exit For
            End If
        Next i
    Loop
   
    Set CombinazioniSemplici = LC
   
End Function

Come ma se K è maggiore di N (numero degli elementi) mi da errore?

E' questa la sub giusta per calcolare le disposizioni con ripetizione di 2 lettere su 7 cifre (2^7) ??

Scusate ma sono un novizio...abbiate pietà!!

[Daniels118]

Combinazioni e disposizioni sono due cose diverse, cosa ti serve esattamente?
In entrambi i casi comunque, quelle "semplici" (cioè senza ripetizione) hanno senso solo per K<=N: come potremmo creare una lista di N elementi diversi se i valori degli elementi sono meno di N?

[Daniels118]

Ti propongo due algoritmi in vbs, il primo è più conciso ed elegante, il secondo è più efficiente e va bene anche per valori di K e N molto grandi:

Public Sub disposizioniConRipetizione(alfabeto(), k, disposizioni())
Dim n		'As Integer
Dim ubAlfabeto	'As Integer
Dim ubParola	'As Integer
Dim nDisp	'As Integer
Dim i		'As Integer
Dim j		'As Integer
Dim parola	'As Integer
Dim sParola	'As String
  ubAlfabeto = UBound(alfabeto)
  n = ubAlfabeto + 1
  ubParola = k - 1
  nDisp = n ^ k
  Redim disposizioni(nDisp - 1)
  For i = 0 To nDisp - 1
    parola = i
    sParola = ""
    For j = 0 To ubParola
      sParola = alfabeto(parola Mod n) & sParola
      parola = parola \ n
    Next 'j
    disposizioni(i) = sParola
  Next 'i
End Sub

Public Sub disposizioniConRipetizione(alfabeto(), k, disposizioni())
Dim n		'As Integer
Dim ubAlfabeto	'As Integer
Dim ubParola	'As Integer
Dim parola()	'As Integer
Dim nDisp	'As Integer
Dim i		'As Integer
Dim j		'As Integer
Dim sParola	'As String
  ubAlfabeto = UBound(alfabeto)
  n = ubAlfabeto + 1
  ubParola = k - 1
  nDisp = n ^ k
  Redim disposizioni(nDisp - 1)
  Redim parola(k)			'Mettiamo un elemento in più di proposito
  For i = 0 To nDisp - 1
    sParola = ""
    For j = ubParola To 0 Step -1
      sParola = sParola & alfabeto(parola(j))
    Next 'j
    disposizioni(i) = sParola
    parola(0) = parola(0) + 1
    For j = 0 To ubParola
      If parola(j) < n Then Exit For
      parola(j) = 0
      parola(j + 1) = parola(j + 1) + 1
    Next 'j
  Next 'i
End Sub