XL 2016 Suppression de doublons en VBA et sous conditions

[luke3300]

Bonjour le forum,

J'ai un fichier dans lequel j'aimerais supprimer des doublons de choix représentés par une "x".
Les colonnes de choix sont les colonnes: E, F, G et H.
Pour certaines lignes, j'ai des "x" dans 2 ou 3 colonnes ce qui me pose problème pour pouvoir les rendre correctement utilisables.
En sachant que les données de la colonne E sont prioritaires, donc que s'il y a une "x" dans une cellule de la colonne E, il ne peut y en avoir pour la même ligne dans les colonnes F, G et H.
En sachant que s'il y a une "x" dans une cellule de la colonne G, il ne peut y en avoir dans les lignes correspondantes des colonnes F et H.
En sachant que s'il y a une "x" dans une cellule de la colonne H, il ne peut y en avoir dans les lignes correspondantes de la colonne F.
Je ne sais pas si je me fais bien comprendre mais en résumé, le contrôle s'effectue comme ceci:
1. si une "x" en E, on la garde et on efface les autres de la même ligne
2. si une "x" en G, on la garde et on efface les autres de la même ligne
3. si une "x" en H, on la garde et on efface les autres de la même ligne

Le nombre de lignes utilisées est très variable, ça peut aller de +/-10 à ...? peut-être choisir dans ce cas un code qui va jusqu'à la dernière ligne contenant des données, non?
Je vous joints mon fichier.

D'ores et déjà, merci à vous tous et toutes pour l'aide que vous pourrez m'apporter.

Bon samedi

 

[job75]

Bonjour luke3300, JHA, Pierre,

Voyez aussi :

Sub Nettoyer_X()
Application.ScreenUpdating = False
On Error Resume Next
[E:H].Replace "x", "#N/A", xlWhole
Intersect([E:E].SpecialCells(xlCellTypeConstants, 16).EntireRow, [F:H]).SpecialCells(xlCellTypeConstants, 16) = ""
Intersect([G:G].SpecialCells(xlCellTypeConstants, 16).EntireRow, [F:F,H:H]).SpecialCells(xlCellTypeConstants, 16) = ""
Intersect([H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow, [F:F,I:I]).SpecialCells(xlCellTypeConstants, 16) = ""
[E:H].Replace "#N/A", "x", xlWhole
End Sub

A+

 

[job75]

Re,

Il est intéressant de tester sur un grand nombre de lignes, par exemple 100 000 lignes.

Chez moi la macro de pierrejean s'exécute en 1,8 seconde, la mienne en 6,3 secondes.

 

[luke3300]

Bonsoir pierrejean, Job75, JHA, le forum,

En effet Job75, la solution de pierrejean est très rapide chapeau bas! ... mais malheureusement je n'ai pas le résultat escompté ... voici en 1ère capture le résultat où l'on voit que les priorités des colonnes G et H ne sont toujours pas prioritaires ... Par contre sur la 2ème capture c'est ton code Job75 et là c'est ok.
Quoi qu'il en soit, je vous remercie énormément tous les 2 pour vvotre temps et le partage de vos connaissances grâce à vous, je vais me simplifier pas mal la vie et je reste admiratifs quand à votre savoir.
Excellente soirée à vous 2 et à bientôt.

 

[job75]

Voici le code de pierrejean corrigé pour qu'il donne les bons résultats :

Sub suppr_x()
tablo = Range("A1:H" & Range("A" & Rows.Count).End(xlUp).Row)
For n = LBound(tablo, 1) To UBound(tablo, 1)
  If UCase(tablo(n, 5)) = "X" Then
       tablo(n, 6) = ""
       tablo(n, 7) = ""
       tablo(n, 8) = ""
  End If
  If UCase(tablo(n, 7)) = "X" Then
       tablo(n, 6) = ""
       tablo(n, 8) = ""
  End If
  If UCase(tablo(n, 8)) = "X" Then tablo(n, 6) = ""
Next
Range("A1").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo
End Sub

 

[luke3300]

Bonjour à tous,

Merci beaucoup Job75 pour ton aide, résultat nickel aussi et plus rapide avec cette solution
Génial! Et encore merci.