Filtrer, copier/coller, supprimer les doublons

Bonjour tout le monde !

Je voudrais faire une macro (pour changer) un peu similaire à la dernière que je souhaitais réaliser (https://forum.excel-pratique.com/viewtopic.php?f=2&t=112670) ...

Sur le fichier que je joins (

43exemple-4.xlsm (22.57 Ko)

), j'aimerais filtrer les données, en ne gardant que :

  • pour la colonne niveau bas ( en G10), les cellules contenant "bas"
  • pour la colonne type d'anomalie ( en V10), les cellules contenant les valeurs "E" et aussi celles contenant "I"

J'aimerais copier l'intégralité du tableau correspondant dans un nouvel onglet portant le nom "Sans infos",, et pour finir dans cet onglet j'aimerais supprimer les doublons, en se basant sur les références ( colonne C10 )

Merci d'avance pour votre aide et à bientôt !

Jeremulus

Bonjour Jeremulus, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)

Set OS = Worksheets("Rapport detaille") 'définit l'onglet source OS
TV = OS.Range("B10").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For I = 2 To NL 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If UCase(TV(I, 6)) = "BAS" And (TV(I, 21) = "E" Or TV(I, 21) = "I") Then 'condition 1 : si le "niveau bas" est "Bas" et si le "Type d'anomalie" est "E " ou "I"
        If Not D.exists(TV(I, 2)) Then 'condition 2 : si la référence n'existe pas comme clé du dictionnaire D
            D.Add TV(I, 2), I 'ajoute la référence comme clé du dictionnaire D (pour éviter les doublons)
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For J = 1 To NC 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV
                TL(J, K) = TV(I, J) 'récupère dans la ligne J de TL la donnée en colonne J de TV (=> transposition)
            Next J 'prochaine colonne de la boucle 2
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set OD = Worksheets("Sans infos") 'définit l'onglet destination OD (génère une erreur si cet onglet n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'supprime l'erreur
    Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
    Set OD = ActiveSheet 'définit l onglet de destination OD
    OD.Name = "Sans infos" 'renomme l'onglet OD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
OD.Cells.ClearContents 'efface le contenus de toutes les cellules de l'onglet OD
OD.Range("A1").Resize(1, UBound(TL, 1)).Value = Application.Index(TV, 1) 'renvoie dans A1 redimensionnée la première ligne du tableau des valeurs TV
OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionnée le tableau TL transposé
End Sub

Bonjour,

Une piste mais avant de tester, ajoute une feuille que tu nommes "Sans infos". Je me suis basé sur ton fichier exemple, si l'original est bien différent (c'est malheureusement souvent le cas dans ce forum), il te faut adapter (voir les commentaires dans le code) :

Sub Test()

    Dim Plage As Range

    'défini la plage sur la feuille "Rapport detaille" à partir de B10 à BT(x)
    '(BT(x) car c'est la dernière colonne qui comporte des valeurs sur toutes les cellules)
    With Worksheets("Rapport detaille"): Set Plage = .Range(.Cells(10, 2), .Cells(.Rows.Count, 72).End(xlUp)): End With

    'supprime un éventuel filtre
    Plage.AutoFilter

    'filtre un 1 ère fois sur le critère "Bas" puis une seconde fois sur les critères "E" ou "I"
    Plage.AutoFilter 6, "Bas"
    Plage.AutoFilter 21, "E", xlOr, "I"

    'supprime tout ce qui pourrait se trouver sur la feuille "Sans infos"
    Worksheets("Sans infos").Cells.Clear

    'et colle le résultat du filtrage
    Worksheets("Rapport detaille").AutoFilter.Range.EntireRow.Copy Worksheets("Sans infos").Range("A1")

    'suppression du filtre
    Plage.AutoFilter

    'redéfini maintenant la plage sur la feuille "Sans infos" à partir de B2 à BT(x)
    With Worksheets("Sans infos"): Set Plage = .Range(.Cells(1, 2), .Cells(.Rows.Count, 72).End(xlUp)): End With

    'puis filtre en place en suppriment les doublons
    Plage.AdvancedFilter xlFilterInPlace, , Worksheets("Sans infos").Cells(1, 2), True

End Sub

Hello ThauThème !

Merci beaucoup, ça marche parfaitement

Si je devais un peu chipoter ... Est ce qu'il est possible de copier/coller le tableau en gardant le même style ? Les bordures ... Les couleurs ... Etc

Encore merci pour ton aide et à bientôt,

Jeremulus

Re,

Le code de Theze fait exactement ça !... Tu devrais l'essayer car en plus il est bien court que le mien...

Exact !

J'ai d'abord essayé le tien avant le sien !

Du coup ça marche parfaitement, nickel merci à vous deux

Je reviens vers vous

Quand je lance la macro sur le fichier sur lequel je travaille ( qui ressemble beaucoup à l'exemple, en simplement beaucoup plus gros ... presque 12 000 lignes) je reçois le message d'erreur suivant :

" Erreur d'exécution 1004: Cette commande requiert au moins deux lignes de données sources. Vous ne pouvez pas l'utiliser sur une seule ligne de donnée. Essayez la méthode suivant : Si vous utilisez un filtre avancé, sélectionnez une plage de cellules qui contient au moins deux lignes de données. Puis cliquez à nouveau sur la commande Filtre élaboré."

Avez vous une idée de ce que je dois changer pour que cela fonctionne ?

Est-ce que la feuille qui reçoit les données du filtrage ("Sans infos") a des valeurs après le premier filtrage et avant la suppression des doublons ?

Pour tester, mets la ligne de code ci-dessous en commentaire et testes pour voir si des valeurs sont rapatriées dans la feuille :

Plage.AdvancedFilter xlFilterInPlace, , Worksheets("Sans infos").Cells(1, 2), True

Vérifie aussi que la plage est bien définie sur toute sa zone avec cette ligne de code :

à insérer après celle-ci :

With Worksheets("Rapport detaille"): Set Plage = .Range(.Cells(10, 2), .Cells(.Rows.Count, 72).End(xlUp)): End With

avance avec la touche F8 (pas à pas)

Quand je mets la ligne

Plage.AdvancedFilter xlFilterInPlace, , Worksheets("Sans infos").Cells(1, 2), True

en commentaire et que je lance la macro, je n'ai plus de message d'erreur mais ... Il ne se passe rien du coup

Je crois que tu as oublié de mettre la ligne de code que je dois insérer

Oups,

la ligne de code est :

MsgBox Plage.Address(0, 0)

et ceci afin de savoir si l'adresse retournée est sensée être bonne (ça, c'est toi qui doit le savoir !)

Bonjour Jeremulus, le forum,

je te retourne ton fichier modifié :

7exemple-4.xlsm (29.10 Ko)

* à l'ouverture du fichier, tu es sur la feuille "Sans infos", qui est entièrement vide

* va sur la 1ère feuille "Rapport detaille" ; fais Ctrl e ➯ travail effectué !

mais c'est seulement la 1ère partie ; y'a pas la 2ème partie de suppression des doublons car pour ça, tu dois joindre un fichier avec des données représentatives, donc avec des doublons à supprimer ! là, avec les quelques données que tu as mises, y'a déjà aucun doublon, alors comment veux-tu qu'on puisse vérifier si la macro fait bien son job ou pas ?

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

dhany

Salut Dhany !

Merci pour cette première partie

Et désolé effectivement il n'y a pas de doublons ... Je pensais qu'il était possible de mettre un code "générique" qui supprime les doublons en se basant sur les références, même si le fichier n'en contient pas ... Enfin bref voilà un fichier avec des doublons

5exemple-4.xlsm (23.71 Ko)

A bientôt

Salut Jeremulus,

voici la 2ème partie :

16exemple-4.xlsm (29.34 Ko)

s'il y avait eu plus de doublons, le résultat aurait été plus significatif !

dhany

Bonjour,

Si je comprend bien, tu ne veux pas que les doublons soient cachés, tu veux les supprimer de la feuille "Sans Infos" ?

Avec modification du code que j'ai posté :

Sub Test()

    Dim Plage As Range

    'défini la plage sur la feuille "Rapport detaille" à partir de B10 à BT(x)
    '(BT(x) car c'est la dernière colonne qui comporte des valeurs sur toutes les cellules)
    With Worksheets("Rapport detaille"): Set Plage = .Range(.Cells(10, 2), .Cells(.Rows.Count, 72).End(xlUp)): End With

    'supprime un éventuel filtre
    Plage.AutoFilter

    'filtre un 1 ère fois sur le critère "Bas" puis une seconde fois sur les critères "E" ou "I"
    Plage.AutoFilter 6, "Bas"
    Plage.AutoFilter 21, "E", xlOr, "I"

    'supprime tout ce qui pourrait se trouver sur la feuille "Sans infos"
    Worksheets("Sans infos").Cells.Clear

    'et colle le résultat du filtrage
    Worksheets("Rapport detaille").AutoFilter.Range.EntireRow.Copy Worksheets("Feuil2").Range("A1")

    'suppression du filtre
    Plage.AutoFilter

    'redéfini maintenant la plage sur la feuille "Sans infos" à partir de B2 à BT(x)
    With Worksheets("Feuil2"): Set Plage = .Range(.Cells(1, 2), .Cells(.Rows.Count, 72).End(xlUp)): End With

    'puis filtre en place en suppriment les doublons
    Plage.AdvancedFilter xlFilterCopy, , Worksheets("Sans infos").Range("A1"), True

    Plage.AutoFilter

    'supprime tout ce qui se trouve sur la feuille "Feuil2"
    Worksheets("Feuil2").Cells.Clear

End Sub

Il te faut rajouter une feuille nommée "Feuil2" afin qu'elle serve momentanément au stockage des valeurs issues du filtrage sans doublons et ceci afin de permettre le rapatriement de ces valeurs vers la feuille "Sans Infos" après suppression des doublons. la feuille peut être masquée.

J'ai fais le test sur plus de 20000 lignes avec plus de 6000 doublons et le temps d'exécution est d'environ 2 secondes.

Rechercher des sujets similaires à "filtrer copier coller supprimer doublons"