Discussion :

[gregory.d]

Bonjour à tous,

Je suis à la recherche d'un code pour une macro sous excel me permetant de gerer des doublons.

Je vous explique ma problématique

Colonne A Colonne B
Code article Indices de production
00001A A
00002B A
00001A B
00001A C
00002B B

Actuellement j'affiche les doublons via la mise en forme conditionnelle et je supprime manuellement les "indices de production" anciens (dans l'exemple je supprime donc pour le code 00001A les indices A et B pour ne garder que le plus élevé soit le C)

J'ai 40K lignes à traiter et mon fichier est maj chaque semaine, existe-t-il une macro qui pourrait faire ce travail à ma place ? (si 00001A indice B existe alors supprimer 00001A indice A puis si 00001A indice C existe alors supprimer 00001A indice B etc...)

Je vous remercie vivement d'avance pour votre aide !

Grégory

[Theze]

Bonjour,

Peut être avec un filtrage (AutoFilter en VBA) et une copie du résultat sur une autre feuille (AutoFilter.Range.EntireRow.Copy) avec ensuite recherche de la valeur maximale de l'indice (Application.WorksheetFunction.Max) puis recherche de la ligne contenant cette valeur Max (Application.WorksheetFunction.Match) et récup des valeurs correspondantes !
Une piste. Je n'ai testé que sur quelques lignes donc je ne sait pas la rapidité sur des milliers. Ici, trois feuilles sont utilisées, la première où sont les valeurs générales, la seconde qui sert d'intermédiaire et la troisième pour la récupération des résultats. Teste déjà sur une copie de ton classeur et sur quelque lignes pour voir :

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Sub Recup()
 
    Dim Fe_1 As Worksheet
    Dim Fe_2 As Worksheet
    Dim Fe_3 As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim Ligne As Long
    Dim Max As Long
    Dim DerLigne As Long
 
    Set Fe_1 = Worksheets("Feuil1")
    Set Fe_2 = Worksheets("Feuil2")
    Set Fe_3 = Worksheets("Feuil3")
 
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'défini la plage sue la feuille "Feuil1" colonne A
    With Fe_1
 
        Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'dédoublonne
    For Each Cel In Plage
 
        If Dico.exists(Cel.Value) = False Then
 
            Dico.Add Cel.Value, Cel.Value
 
        End If
 
    Next Cel
 
    'redéfini la plage sur les colonnes cibles, ici A1 à C...
    'La plage est sensée avoir une ligne d'entêtes
    With Fe_1
 
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 3).End(xlUp))
 
    End With
 
    'parcour les codes article uniques pour le filtrage
    For Each Cle In Dico.Keys
 
        Plage.AutoFilter 1, Cle 'applique le filtre
        Fe_1.AutoFilter.Range.EntireRow.Copy Fe_2.Range("A1") 'copie le résultat sur la feuille "Feuil2"
        Plage.AutoFilter 'supprime le filtre
 
        With Fe_2
 
            'recherche la valeur max
            Max = Application.WorksheetFunction.Max(.Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)))
 
            'recherche la ligne où se trouve cette valeur max
            Ligne = Application.WorksheetFunction.Match(Max, .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)), 0)
 
            'cherche la première ligne vide
            DerLigne = Fe_3.Cells(Rows.Count, 1).End(xlUp).Row + 1
 
            'et récupère le résultat ici, sur les trois colonnes...
            Fe_3.Range(Fe_3.Cells(DerLigne, 1), Fe_3.Cells(DerLigne, 3)).Value = .Range(.Cells(Ligne + 1, 1), .Cells(Ligne + 1, 3)).Value
 
            'vide la feuille "Feuil2" qui sert d'intermédiaire
            .Cells.Clear
 
        End With
 
    Next Cle
 
End Sub

Hervé.

[Menhir]

Tu commences par faire un tri (Sort) sur ta plage de données (les deux colonnes) en prenant la colonne A en clé 1 et la colonne B en clé 2.
Ensuite, tu fais une boucle qui remonte de la dernière cellule à la première. Si une cellule à le même code article que celle du dessous, tu supprimes la ligne.

Bred, c'est un code de 4 ou 5 lignes.

[Theze]

Bonsoir Menhir,

en fait, ce n'est pas aussi simple car il faut trouver la valeur maximale des doublons et garder seulement celle là, si j'ai bien compris ce que demande Grégory !

Hervé.

[gregory.d]

Bonsoir

Je vous remercie de m'avoir répondu

Je n'ai pas essayer la 1ere solution, je regarde sa de suite.

@Theze oui vous avez bien compris ma demande

Encore merci

Bonsoir

Le code de Theze plante à cet endroit :

Code :

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

   Ligne = Application.WorksheetFunction.Match(Max, .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)), 0)

Une petite idée ?

Je fournis une partie du fichier... Classeur1.xlsm

Merci d'avance pour vos suggestions

Grégory

[SfJ5Rpw8]

bonsoir ,


le code "plante" ??? , traduction S.V.P ?

[gregory.d]

Bonsoir,

"erreur s'execution '1004':
impossible de lire la propriété Match de la classe Worksheetfunction

[keygen08]

Bonjour

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
Sub doublons()
dim cell as range
For Each cell In Range("a1:a" & Cells(Cells.Rows.Count, 1).End(xlUp).Row)
With Worksheets(1).Range("a1:a" & Cells(Cells.Rows.Count, 1).End(xlUp).Row)
    Set c = .Find(cell, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            If c.Offset(0, 1).Value > cell.Offset(0, 1).Value Then cell.Interior.ColorIndex = 3
'pour test je colorie les cellules a supprimer en rouge
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
Next cell
End Sub

[gregory.d]

Bonsoir

Je vous remercie énormément le code fonctionne. Le temps de traitement est long mais cela me laisse du temps pour faire autre chose !!

Que mettre pour que les lignes soient supprimées au fur et à mesure ?

Bonne soirée

Cordialement

[Menhir]

en fait, ce n'est pas aussi simple car il faut trouver la valeur maximale des doublons et garder seulement celle là, si j'ai bien compris ce que demande Grégory !

Et à ton avis, pourquoi ai-je indiqué qu'il fallait mettre la seconde colonne "Indice de production" en clé 2 dans le tri ?

[gregory.d]

Bonjour,

Je ne suis pas très à l'aise avec VBA, Menhir avez vous une ebauche de code à me communiquer ?

Merci d'avance

Grégory

[Menhir]

Je t'ai donné tous les noms d'objets impliqués, il te suffisait de regarder dans l'aide VBA intégrée à Excel.
Mais comme il est plus rapide d'écrire ce code que de te l'expliquer :

Code :

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

1
2
3
4
5
Dim Ligne As Long, x As Variant
x = Range(Cells(2, 1), Cells(2, 2).End(xlDown)).Sort(Range(Cells(2, 1), Cells(2, 1).End(xlDown)), xlAscending, Range(Cells(2, 2), Cells(2, 2).End(xlDown)), , xlAscending)
For Ligne = Cells(2, 1).End(xlDown).Row To 2 Step -1
   If Cells(Ligne, 1).Value = Cells(Ligne + 1, 1).Value Then Rows(Ligne).Delete
Next Ligne

Comme je le disais, 5 lignes en comptant le Dim qui est facultatif.

Utiliser le Sort de l'objet Worksheet aurait été plus propre que d'utiliser celui de l'objet Range mais ça aurait fait plus de lignes.

[gregory.d]

Bonjour Menhir et merci pour ta réponse

Dans mon fichier de base les données sont dans l'onglet "Extrait", les articles en colonne E (E2) et les indices en colonne L (L2).

Quels sont les elements à changer dans le code pour cette prise en compte ?

Je te remercie d'avance

Grégory

[Menhir]

Dans l'aide VBA, regarde la syntaxe de la méthode Sort de l'objet Range.
Regarde aussi la syntaxe de Cells et de Range.

[zenpbb]

Bonjour,

Une variante des propositions précédentes est d'utiliser la fonctionnalité Excel "Supprimer les doublons", qui a l'avantage d'être beaucoup plus rapide qu'un balayage des lignes, et de pouvoir être réalisée sans VBA en 2 étapes simples :

(Testé sur XL 2010 mais en version 2013 ça ne devrait pas être différent)
1- Trier la plage de données sur la colonne E (articles) ordre croissant et sur la colonne L (indices) ordre décroissant
2- Sélectionner la plage de données et "Supprimer les doublons" (onglet Données). Décocher toutes les colonnes, puis re-cocher uniquement la colonne E (articles) et cliquer sur OK.
(ensuite, trier éventuellement les données selon les critères souhaités)

Pour avoir une ébauche de code, il suffit de réaliser cette opération en enregistrant une macro.
Voici après quelques adaptations, un exemple de ce que ça peut donner :

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
Sub SupprDoublons()
 
Dim nbligne As Long
 
    With Worksheets("Extrait")
        nbligne = .Range("A" & .Rows.Count).End(xlUp).Row
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("E2:E" & nbligne), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Sort.SortFields.Add Key:=.Range("L2:L" & nbligne), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        With .Sort
            .SetRange .Parent.UsedRange
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        .UsedRange.RemoveDuplicates Columns:=5, Header:=xlYes
    End With
 
End Sub

[gregory.d]

Menhir,

Je ne comprend pas l'explication que me donne VBA via Excel, Je n'ai pas non plus l'habitude d'utiliser VBA comme cela pour les choses simples j'utilise l'enregistrement d'une macro avec quelques petites modifications

Code :

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

Function Sort([Key1], [Order1 As XlSortOrder = xlAscending], [Key2], [Type], [Order2 As XlSortOrder = xlAscending], [Key3], [Order3 As XlSortOrder = xlAscending], [Header As XlYesNoGuess = xlNo], [OrderCustom], [MatchCase], [Orientation As XlSortOrientation = xlSortRows], [SortMethod As XlSortMethod = xlPinYin], [DataOption1 As XlSortDataOption = xlSortNormal], [DataOption2 As XlSortDataOption = xlSortNormal], [DataOption3 As XlSortDataOption = xlSortNormal])

Je te remercie pour ton aide

Grégory

Bonjour Zenpbb,

La solution fonctionne et est très rapide je vous remercie !

Je cloture le sujet

Bonne journée à tous et merci de votre aide

Grégory