XL 2016 trier liste et supprimer les doublons avec conditions

antonerty

XLDnaute Nouveau
Bonjour,

je débute dans le VBA et j'aimerais avoir quelques conseils.

Je voudrais extraire des données d'une liste , mais en respectant les lignes et en supprimant les doublons .

c'est à dire qu'un numéro correspond à un seul libellé mais peut avoir un seul ou plusieurs sous numéro.

voici ce que j'ai réussi à faire mais , je n'arrive pas à extraire les sous numéros.
 

Pièces jointes

  • Test suppression doublon.xlsm
    70.1 KB · Affichages: 13
Solution
Re,

Même macro améliorée, avec colonnes aux bons endroits et tri sur colonne 1
VB:
Public Sub Créermaliste()
    Dim shSource As Worksheet, shDest As Worksheet
    
    '
    ' Définitions des feuille source et destination
    Set shSource = ThisWorkbook.Sheets("Données")
    Set shDest = ThisWorkbook.Sheets("Critères TB")
    '
    ' Supprimer les données déjà existantes dans la destination
    shDest.Range("A1").CurrentRegion.ClearContents
    '
    ' importer les données
    With shSource.Range("A1").CurrentRegion
        .Columns(2).Copy shDest.Range("A1")
        .Columns(3).Copy shDest.Range("B1")
        .Columns(1).Copy shDest.Range("C1")
    End With

    '
    '
    With shDest
        MsgBox "Lignes avant suppression des...

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Il me semble que vous voulez supprimer les doublons sur trois colonnes ? Si oui, la macro suivante le fait :
VB:
Public Sub Créermaliste()
    With ThisWorkbook.Sheets("Critères TB")
        '
        ' Supprimer les données déjà existantes
        .Range("A1").CurrentRegion.ClearContents
        '
        ' importer les données
        ThisWorkbook.Sheets("Données").Range("A1").CurrentRegion.Copy .Range("A1")
        '
        '
        MsgBox "Lignes avant suppression des doublons : " & .Range("A1").CurrentRegion.Rows.Count - 1, vbInformation, "Suppression des doublons"
        '
        ' supprimer les doublons de la nouvelle région
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
        '
        '
        MsgBox "Lignes après suppression des doublons : " & .Range("A1").CurrentRegion.Rows.Count - 1, vbInformation, "Suppression des doublons"
    End With
End Sub

Cordialement
 

Pièces jointes

  • Test suppression doublon.xlsm
    78.1 KB · Affichages: 2

antonerty

XLDnaute Nouveau
merci pour votre réponse,

mais en fait un numéro correspond à un seul libellé mais peut avoir un ou plusieurs sous numéro .Supprimer les doublons ne correspond pas à ce que je cherche

en fait voici ce que je recherche
ex : le Numéro OPE-2020-0106 correspond aux libellé SAPHI et au sous -numéro 1780
mais il peut y avoir le Numéro OPE-2019-0153 qui correspond au libellé MCO 2 avec plusieurs sous numéro 1731, 1811,1821 etc


Je sais pas si c'est très clair ce que je dis.
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

N'est-ce pas ce qu'obtient la macro donnée, après tri :

1611074626849.png


Et la même chose pour tous les numéros.

Cela peut se faire avec powerquery également.

Si cela ne convient pas, faites un exemple manuellement du résultat que vous souhaitez, avec explications.

Cordialement
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re,

Même macro améliorée, avec colonnes aux bons endroits et tri sur colonne 1
VB:
Public Sub Créermaliste()
    Dim shSource As Worksheet, shDest As Worksheet
    
    '
    ' Définitions des feuille source et destination
    Set shSource = ThisWorkbook.Sheets("Données")
    Set shDest = ThisWorkbook.Sheets("Critères TB")
    '
    ' Supprimer les données déjà existantes dans la destination
    shDest.Range("A1").CurrentRegion.ClearContents
    '
    ' importer les données
    With shSource.Range("A1").CurrentRegion
        .Columns(2).Copy shDest.Range("A1")
        .Columns(3).Copy shDest.Range("B1")
        .Columns(1).Copy shDest.Range("C1")
    End With

    '
    '
    With shDest
        MsgBox "Lignes avant suppression des doublons : " & .Range("A1").CurrentRegion.Rows.Count - 1, vbInformation, "Suppression des doublons"
        '
        ' supprimer les doublons de la nouvelle région
        .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
        '
        ' Trier sur colonne 1
        .Range("A1").CurrentRegion.Sort key1:=.Columns(1).Cells(2, 1), Order1:=xlDescending, Header:=xlYes

        '
        MsgBox "Lignes après suppression des doublons : " & .Range("A1").CurrentRegion.Rows.Count - 1, vbInformation, "Suppression des doublons"
    End With

End Sub

Cordialement
 

Discussions similaires