Dédoublonner des lignes différentes

bonjour à tous,

comment dédoublonner des lignes qui ne sont pas exactement les mêmes mais dont 1 colonne est semblable ?

TV samsung,041000,neuf

TV samsung,041000,stock

TV samsung,041000,occasion

dans cet exemple je ne voudrais garder qu'une ligne pour le produit samsung dédoublonnant sur la 2 me colonne : 041000.

Résultat après dédoublonnage :

TV samsung,041000,neuf

merci !

Bonjour

Ta demande n'est pas très claire.

Peut-être avec un fichier et un exemple de ce que tu as et de ce que tu veux obtenir, on pourrait te proposer quelque chose...

Bye !

Bonsoir à tous,

Pas très clair en effet

Tes données à partir de la ligne 1, sans en-têtes

Option Explicit
Sub Retenir_le_premier()
Dim r As Range, x As Range
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In Sheets(1).Range("a1").CurrentRegion.Columns(1).Cells
            If Not .exists(r.Value & r.Offset(, 1).Value) Then
                .Item(r.Value & r.Offset(, 1).Value) = Empty
            Else
                If x Is Nothing Then
                    Set x = r.EntireRow
                Else
                    Set x = Union(x, r.EntireRow)
                End If
            End If
        Next
        If Not x Is Nothing Then x.Select
        'If Not x Is Nothing Then x.Delete
        Set x = Nothing
    End With
End Sub

Le code réajusté pour répondre au post #4

Option Explicit

Sub Retenir_le_premier()
Dim r As Range, x As Range, rng As Range
    With Sheets("Feuil1")
        Set rng = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            If Not .exists(r.Value & r.Offset(, 1).Value) Then
                .Item(r.Value & r.Offset(, 1).Value) = Empty
            Else
                If x Is Nothing Then
                    Set x = r.EntireRow
                Else
                    Set x = Union(x, r.EntireRow)
                End If
            End If
        Next
        If Not x Is Nothing Then x.Select
        'If Not x Is Nothing Then x.Delete
        Set x = Nothing
        Set rng = Nothing
    End With
End Sub

klin89

bonjour

effectivement pas très clair, je joins un fichier d'exemple.

Merci

Re,

Comme ceci, on tourne en rond non 8)

Option Explicit

Sub Retenir_le_premier()
Dim r As Range, rng As Range, x, y, i As Long
    With Sheets("Feuil1").Range("a1").CurrentRegion.Offset(1)
        Set rng = .Columns("a").Resize(.Rows.Count - 1)
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng.Cells
            If Not .exists(r.Value & r.Offset(, 1).Value) Then
                .Item(r.Value & r.Offset(, 1).Value) = _
                VBA.Array(r.Value, r.Offset(, 1).Value, r.Offset(, 2).Value)
            End If
        Next
        x = .keys: y = .items
    End With
    For i = 0 To UBound(x)
        Sheets("Feuil1").Range("a" & Rows.Count).End(xlUp)(2) _
                .Resize(, UBound(y(i), 1) + 1).Value = y(i)
    Next
    Set rng = Nothing
End Sub

klin89

Merci Klin89

cela fonctionne bien, mais cela ne supprime pas les lignes sources, je ne souhaite garder que le résultat TV samsung,041000,neuf

Est ce possible aussi que la macro fonctionne avec plus de colonnes

Merci

Matthieu

Re matthieu-paris,

Pour supprimer, remplace cette ligne

If Not x Is Nothing Then x.Select

par ceci

 If Not x Is Nothing Then x.Delete

Pour identifier tes doublons, je définis la clé comme ceci, soit sur tes 2 premières colonnes

r.Value & r.Offset(, 1).Value

Je ne comprends pas, précise ta pensée

Est ce possible aussi que la macro fonctionne avec plus de colonnes  

klin89