Discussion :

[yobor]

bonjour à tous ,
j'ai un tableau de deux colonnes "lot 1" et "lot 2" , chaqu'une des deux contiens des produits "p1,p2,...." et il y a une répétition au niveau de chaque colonne (c-à-d : lot 1 : p1,p2,p1,p6,p2...) et il y aussi des produits commun , mon objectif et de regrouper tous les produits des deux colonnes dans une seule colonne "produits" et sans répétition( p1,p2,p3,p4,.....) en utilisons la suppression des doublons, comment faire et merci d'avance ??vous trouvez mon fichier au dessous :

[Marc-L]

Bonjour,

par exemple tout copier dans une colonne puis utiliser la fonctionnalité d'Excel de suppression de doublons …

_________________________________________________________________________________________________________

Je suis Paris, Nice, Bruxelles, Charlie, …

[yobor]

oui, justement ça ce que j'ai fais déjà mais je trouve qu'il y a encore des doublons !!, le fichier que j'ai déjà posté est seulement une version miniature ,j'ai presque 7000 ligne dans chaque colonne ,et les p1,p2...sont des références des produits sous cette forme "1604901Z ,E0007193,... " ,Je n’ai pas pu les partager parce qu'ils sont un peu confidentiels, merci de m'aidez plus parce que ce problème m'a bloqué plus que 2 jours .

[RyuAutodidacte]

Bonsoir

un petit code que j'ai fait vite fait (surement perfectible) basé sur votre fichier :
si vous avez encore des doublons après cela, c'est peut être que quelque chose ne va pas dans votre fichier,
car il n'y a aucune raison apparente de retrouver des doublons après avoir suivi le conseil de @Marc-L.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Pdts_Sans_doublons()
Dim VA, V, DL1&, DL2&, DL&, Produits As New Collection, Tab_Pdts()
 
Application.ScreenUpdating = False
    DL1 = Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne Col A
    DL2 = Range("B" & Rows.Count).End(xlUp).Row 'Dernière ligne Col B
    DL = DL1 + DL2 - 2 'Nb lignes - en-têtes
 
    VA = Application.Transpose(Range("A2:A" & DL1).Value) 'On ajoute les valeurs de la col A dans le tableau VA  à 1 dim
    ReDim Preserve VA(1 To DL)
 
    For x& = 1 To DL2 - 1
        VA(DL1 + x - 1) = Range("B" & x + 1).Value 'on rajoute dans VA les valeurs de la col B
    Next
 
    i& = 2
    On Error Resume Next
    For Each V In VA
        Produits.Add VA(i), CStr(VA(i)) 'A partir d'une collection on supprime les doublons pour ne garder qu'une unique valeur
        If Err.Number <> 0 Then
            Err.Clear
        End If
        i = i + 1
    Next
    On Error GoTo 0
 
    ReDim Tab_Pdts(1 To Produits.Count)
    For i = 1 To Produits.Count 'on transvase la collection dans un tableau
    Tab_Pdts(i) = Produits(i)
    Next
    Range("C2").Resize(Produits.Count) = Application.Transpose(Tab_Pdts) 'on copie l'ensemble des valeurs à partir de C2
 
Application.ScreenUpdating = True
Set Produits = Nothing
 
End Sub

[Klin89]

Bonsoir à tous,

J'aurais procédé comme Marc, mais bon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub test()
Dim a, i As Long, j As Long, y
    With Sheets(1)
        With .Range("a1").CurrentRegion.Resize(, 2)
            a = .Value
            With CreateObject("Scripting.Dictionary")
                .CompareMode = 1
                .Add "Produits", Nothing
                For j = 1 To UBound(a, 2)
                    For i = 2 To UBound(a, 1)
                        If Not .exists(a(i, j)) Then
                            .Add a(i, j), Nothing
                        End If
                    Next
                Next
                y = .keys
            End With
        End With
        .Range("l1").Resize(UBound(y) + 1).Value = Application.Transpose(y)
    End With
End Sub

klin89

[yobor]

Super, vos solutions me convient très bien ,merci à vous tous

[jurassic pork]

hello,
voici une autre solution en utilisant une arraylist et en faisant un tri (pas terrible le tri quand les chiffres en fin de chaîne n'ont pas le même nombre de digits (ex p1 p11 seraient mieux en p01 p11))

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub MesProduits()
Dim TabProduits()
Dim x, y As Integer
Dim arrList As Object
Set arrList = CreateObject("System.Collections.ArrayList")
Application.ScreenUpdating = False
TabProduits = Range("A2:B15")
For x = 1 To UBound(TabProduits, 1)
  For y = 1 To UBound(TabProduits, 2)
      arrList.Add TabProduits(x, y)
  Next
Next
' on trie la liste
arrList.Sort
x = 2
oldprod = ""
For Each prod In arrList
  ' on élimine les doublons en comparant à celui d'avant
  If prod <> oldprod Then
  'on affiche le résultat à partir de K2
   Range("K" & x) = prod
    x = x + 1
  End If
  oldprod = prod
Next
Application.ScreenUpdating = True
End Sub

Ami calmant, J.P

[yobor]

Merci beaucoup jurassic pork

[Klin89]

Bonjour jurassic pork,

Pourquoi tu n'utilises pas la méthode Contains de l'objet ArrayList

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub MesProduits()
Dim TabProduits()
Dim x, y As Integer
Dim arrList As Object
    Set arrList = CreateObject("System.Collections.ArrayList")
    Application.ScreenUpdating = False
    TabProduits = Range("A2:B15")
    For x = 1 To UBound(TabProduits, 1)
        For y = 1 To UBound(TabProduits, 2)
            If Not arrList.Contains(TabProduits(x, y)) Then arrList.Add TabProduits(x, y)
        Next
    Next
    ' on trie la liste
    arrList.Sort
    'Restitution
    Range("K2").Resize(arrList.Count).Value = Application.Transpose(arrList.ToArray)
    Application.ScreenUpdating = True
End Sub

klin89

[jurassic pork]

hello,

effectivement on peut faire comme cela aussi mais je ne sais pas si cela ralentit de manière non négligeable le remplissage de l'arraylist.

Ami calmant, J.P