XL 2016 Supression des doublons

guellila

XLDnaute Junior
Bonjour

je cherche a supprimer les lignes sur un tableau avec comme condition les valeurs en double dans la colonne C (Operation) mais sans supprimer les lignes avec la valeur #N/A

ABBAOperation
AL4844.1AL5330.1AL5330.1AL4844.114,65714299
ME2600.1ME2736.1ME2736.1ME2600.120,25000018
TO5819.1TO1530.1TO1530.1TO5819.128,89729756
EB POS01.1EBB01/EB3218.1EBB01/EB3218.1EB POS01.139,96286509
OR5307.1OR6040.1OR6040.1OR5307.148,45940256
ORT01.12OR3148.1OR3148.1ORT01.1256,11460228
BJ0678.1BJ0215.1BJ0215.1BJ0678.146,92413836
BL0923.2BL3407.1BL3407.1BL0923.2#N/A
OU3077.1OU3024.1OU3024.1OU3077.161,71428628
BM3510.1BM3572.1BM3572.1BM3510.162,89411822
ME2736.1ME2600.1ME2600.1ME2736.120,25000018
AL5330.1AL4844.1AL4844.1AL5330.114,65714299
BJ0215.1BJ0678.1BJ0678.1BJ0215.146,92413836
BM3572.1BM3510.1BM3510.1BM3572.162,89411822
OU3024.1OU3077.1OU3077.1OU3024.161,71428628
TO1530.1TO5819.1TO5819.1TO1530.128,89729756
BM3511.1BM6448.1BM6448.1BM3511.1#N/A
BM3538.1BM6414.1BM6414.1BM3538.1#N/A
SAT06.1SAT03/SA2011.2SAT03/SA2011.2SAT06.1#N/A
OR3173.1OR5349.1OR5349.1OR3173.1#N/A
EBB01/EB3218.1EB POS01.1EB POS01.1EBB01/EB3218.139,96286509
EB3239.1EB3216.2EB3216.2EB3239.1#N/A
MO2761.2MO2785.1MO2785.1MO2761.2#N/A
MO2710.1MO2743.2MO2743.2MO2710.1#N/A
OR6042.1OR5987.1OR5987.1OR6042.1#N/A
OR3148.1ORT01.12ORT01.12OR3148.156,11460228
ATT05.4OR3165.1OR3165.1ATT05.4#N/A
ATT05.4AT4664.1AT4664.1ATT05.4#N/A
merci d'avance
 

job75

XLDnaute Barbatruc
Bonjour guellila, JHA,

Voici une solution VBA avec les macros des 2 boutons :
VB:
Sub Supprimer_doublons()
Dim d As Object, a, i&, x
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [A1].CurrentRegion.EntireRow 'lignes entières pour conserver les hauteurs des lignes
    a = .Columns(3).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 1 To UBound(a)
        x = a(i, 1)
        If IsError(x) Then
            a(i, 1) = 1
        Else
            If d.exists(x) Then a(i, 1) = "#N/A" Else a(i, 1) = 1: d(x) = ""
        End If
    Next
    '---restitution et filtrage---
    .Columns(3).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(3) = a
    .Sort .Columns(3), xlAscending 'tri pour regrouper et accélérer
    On Error Resume Next 'si aucune SpecialCell
    .Columns(3).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les doublons
    .Columns(3).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
End Sub

Sub Reinitialiser()
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Sheets("Initialisation").Cells.Copy [A1]
[A1].Copy [A1] 'allège la mémoire
End Sub
Utilisant un tableau VBA et le Dictionary ainsi qu'un tri la suppression est très rapide.

A+
 

Pièces jointes

  • Supprimer les doublons(1).xlsm
    22.4 KB · Affichages: 7
Dernière édition:

guellila

XLDnaute Junior
Bonsoir job75
merci pour ta solution elle est exactement ce que je cherche ,maintenant j'ai juste besoin de savoir comment l'intégré a mon tableau qui commence a partir de colonne AP et toujours avec la même critère supprimer les doublons dans la colonne opération qui se trouve maintenant dans la colonne AV

merci
 

Pièces jointes

  • Classeur3.xlsx
    15.2 KB · Affichages: 4

job75

XLDnaute Barbatruc
2 adaptations sont possibles, voyez les fichiers joints.

Tâchez de bien comprendre les différences car c'est très instructif.

Bonne nuit.
 

Pièces jointes

  • Classeur3(1).xlsm
    32.3 KB · Affichages: 2
  • Classeur3(2).xlsm
    32.9 KB · Affichages: 3

guellila

XLDnaute Junior
Bonjour job75
merci beaucoup pour votre aide , je prendrais votre commentaire pour un motivation , j'ai essayer de le faire moi même en copiant le code et de l'adapter a mes besoin mais je me suis trempé sur le numéro de la colonne j'ai garder le même code mais j'ai seulement changé le numéro 3 par 7 et ca na pas marché

encore une fois merci Job75
 

Discussions similaires

Statistiques des forums

Discussions
312 337
Messages
2 087 390
Membres
103 534
dernier inscrit
Kalamymustapha