creation de liste de combinaison uniques

[knaekes]

Bonjour,

A partir d'un tableau comportant diverse données, je souhaite créer une liste des combinaison mais en supprimant les doublons.

voir exemple ci-joint

cordialement

 

[Dugenou]

Re : creation de liste de combinaison uniques

Bonjour knaekes,

Je te propose une méthode avec un TCD intermédiaire.
Il m'a semblé que le TCD présentait les données comme tu voulais, il faut simplement gérer avec finesse les formules d'affichage (en rouge dans la pj)

Cordialement

 

[knaekes]

Re : creation de liste de combinaison uniques

merci pour ta réponse, cependant je recherche une solution sous visual basic (afin de l'adapter plus facilement à mon cas de figure)

 

[david84]

Re : creation de liste de combinaison uniques

Bonjour,
puisque tu es sous Excel 2007, à tester :

Sub Test()
Dim Tablo
    [B6].CurrentRegion.Replace What:="", Replacement:="-", SearchOrder:=xlByColumns
    [B6].CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlNo
     Tablo = [B6].CurrentRegion.Value
     [G6].Resize([B6].CurrentRegion.Columns.Count, [B6].CurrentRegion.Rows.Count) = Application.Transpose(Tablo)
     [B6].CurrentRegion.ClearContents
End Sub

A+

 

[knaekes]

Re : creation de liste de combinaison uniques

En fait dans mon cas les données sont inclues dans un tableau avec d'autres éléments tout autour. Il m'est donc délicat de procéder à une transposition.

En fait j'essaye de m'inspirer d'un code que j'avais obtenu (peut être sur ce forum) pour en tirer partie.

ci joint le fichier avec mon essai

 

[david84]

Re : creation de liste de combinaison uniques

Re
peut-être en modifiant comme cela alors :

Sub Test2()
Dim Tablo
    [A4].CurrentRegion.Copy Destination:=[F4]
    [F4].CurrentRegion.Replace What:="", Replacement:="-", SearchOrder:=xlByColumns
    [F4].CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
        Header:=xlNo
     Tablo = [F4].CurrentRegion.Value
     [F4].CurrentRegion.ClearContents
     [F3].Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
End Sub

Sinon, passer par un tableau VBA et utiliser un dictionnaire pour écarter les doublons, charger la sélection dans un tableau VBA et replacer ce tableau dans la feuille de calcul à l'endroit voulu.
A+

 

[david84]

Re : creation de liste de combinaison uniques

Re re
en appliquant l'autre solution indiquée dans mon message précédent :

Sub test3()
Application.ScreenUpdating = False
Set plage = [A4].CurrentRegion
Set mondico = CreateObject("scripting.Dictionary")
ligne = 1
For i = 4 To plage.Rows.Count + 3
    temp = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4)
        If Not mondico.exists(temp) Then
            mondico.Add temp, temp
            Dim Tablo()
            ReDim Preserve Tablo(1 To plage.Rows.Count + 3, 1 To plage.Columns.Count)
                For j = 1 To plage.Columns.Count
                    Tablo(ligne, j) = Cells(i, j)
                Next j
            ligne = ligne + 1
        End If
Next i
[F3].Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
[F3].Resize(plage.Columns.Count, mondico.Count).Replace What:="", Replacement:="-", SearchOrder:=xlByColumns
Application.ScreenUpdating = True
End Sub

A+

 

[knaekes]

Re : creation de liste de combinaison uniques

Ok merci pour cette réponse. Cependant comment faire pour ne pas perturber le tableau créé si l'espace qui entoure le tableau d'origine n'est pas vide? Par exemple si je rempli les cellules de la ligne 24 et de la colonne E (mais que ces données ne sont pas à prendre en compte)

merci d'avance

 

[david84]

Re : creation de liste de combinaison uniques

Re

Cependant comment faire pour ne pas perturber le tableau créé si l'espace qui entoure le tableau d'origine n'est pas vide? Par exemple si je rempli les cellules de la ligne 24 et de la colonne E (mais que ces données ne sont pas à prendre en compte)

d'où la nécessité de produire un exemple fidèle🙄...
Place un exemple explicite sur un fichier et je regarderai.
A+

 

[knaekes]

Re : creation de liste de combinaison uniques

Ci-joint un exemple plus representatif de mon cas de figure.

merci

 

[knaekes]

Re : creation de liste de combinaison uniques

queslqu'un aurait-il une proposition à faire, pour résoudre mon cas de figure? Merci d'avance

 

[david84]

Re : creation de liste de combinaison uniques

Re
A défaut d'information plus précise, ci-joint un code répondant a priori à la configuration du dernier fichier présenté :

Sub test4()
Application.ScreenUpdating = False
DerLigne = Range("A" & Rows.Count).End(xlUp).Row - 2
Set Plage = Range(Cells(6, 3), Cells(DerLigne, 7))
Set mondico = CreateObject("scripting.Dictionary")
ligne = 1
For i = 1 To Plage.Rows.Count
    temp = Plage(i, 1) & Plage(i, 2) & Plage(i, 3) & Plage(i, 4) & Plage(i, 5)
        If Not mondico.exists(temp) Then
            mondico.Add temp, temp
            Dim Tablo()
            ReDim Preserve Tablo(1 To Plage.Rows.Count, 1 To Plage.Columns.Count)
                For j = 1 To Plage.Columns.Count
                    Tablo(ligne, j) = Plage(i, j)
                Next j
            ligne = ligne + 1
        End If
Next i
[J3].Resize(UBound(Tablo, 2), UBound(Tablo)) = Application.Transpose(Tablo)
[J3].Resize(Plage.Columns.Count, mondico.Count).Replace What:="", Replacement:="-", SearchOrder:=xlByColumns
Application.ScreenUpdating = True
End Sub

Après, on peut certainement cerner la plage de manière plus précise, mais je n'ai pas les informations pour.
A+
Edit : attention : ton dernier fichier comporte des cellules dont la valeur n'apparaît pas (retoucher la mise en forme car sinon une partie des valeurs apparaissent en couleur de police blanche sur fond blanc).