Ne laisser qu'un doublon visible

Bonjour le forum,

J'ai une demande un peu particulière, je souhaite masquer les doublons et n'en laissé que 1 visible, est-ce possible avec VBA ?

Malgré mes recherches je ne trouve pas :-(

Ci joint un exemple qui je l'espère sera assez explicite

Un grand merci pour votre aide

CDB

Bonjour,

il existe plusieurs solutions qui me viennent à l'esprit:

1. supprimer les doublons avec la fonction Excel qui est faite pour, a pour désavantage de supprimer définitivement les doublons
2. utiliser NB.SI pour calculer le nombre de fois que la valeur est apparue sur les lignes précédentes, a pour avantage de fonctionner dans un tableau non trié mais demande beaucoup de calculs sur un tableau avec beaucoup de lignes
3. utiliser un SI pour vérifier si la ligne précédente contient le même code, peu de calcul mais ne fonctionne que si les codes se suivent correctement, et donc si le tableau est trié pour

Je joins un fichier qui illustre les solutions.

EDIT: oups je n'ai pas vu "avec VBA"

bonjour

colle ça dans un module

pour masquer les doublons

Sub cache_doublon()
    Dim X&, I&, tablo, plage As Range, ecart&
    Set plage = Feuil1.[A3].CurrentRegion.Columns(1)
    tablo = Application.Transpose(plage.Value)
    ecart = plage.Row - 1
     For I = 1 To UBound(tablo)
        X = Application.Match(tablo(I), tablo, 0)
        If X <> I Then Feuil1.Rows(I + ecart).Hidden = True
    Next
End Sub

pour les démasquer

Sub montre_doublon()
Dim plage
Set plage = Feuil1.[A3].CurrentRegion.Columns(1)
 plage.EntireRow.Hidden = False
End Sub

Merci beaucoup pour votre aide

Admettons que je souhaite supprimer les lignes, en remplaçant Hidden par delete cela met une erreur 400.

Est-ce normal ?

Bonjour,

Pour delete il ne faut pas donner d'argument de type true, on peut à la limite dire dans quel sens décaler les cellules mais rien de plus, également pour la suppression d'un tableau on part généralement de la fin du tableau pour ne pas avoir à s'inquiéter du décalage de ligne que la suppression génère.

Je suppose que ça donnerait

Sub sup_doublon()
    Dim X&, I&, tablo, plage As Range, ecart&
    Set plage = Feuil1.[A3].CurrentRegion.Columns(1)
    tablo = Application.Transpose(plage.Value)
    ecart = plage.Row - 1
    For I = UBound(tablo) To 1 Step -1
        X = Application.Match(tablo(I), tablo, 0)
        If X <> I Then Feuil1.Rows(I + ecart).EntireRow.Delete
    Next
End Sub

Super merci beaucoup pour les explications

Désolé de revenir vers vous.

En modifiant le nom de ma feuille cela génère un problème OBJET.

Pourquoi ?

Dans le code de sub test on fait appel à feuil2, cette feuille n'existe plus et doit être remplacée par feuil1 dans le code, c'est pour ça que ce message d'erreur apparait.

Du coup il faut mettre:

Sub test()

 Dim X&, I&, tablo, plage As Range, ecart&
    Set plage = Feuil1.[A3].CurrentRegion.Columns(1)
    tablo = Application.Transpose(plage.Value)
    ecart = plage.Row - 1
    For I = UBound(tablo) To 1 Step -1
        X = Application.Match(tablo(I), tablo, 0)
        If X <> I Then Feuil1.Rows(I + ecart).EntireRow.Delete
    Next

End Sub

Je sais c'est pour cela que j'ai adapté le code en fonction du nom de ma feuille.

Dans le fichier la feuille est Data, à noter qu'il y deux feuilles.

J'ai donc fait cela mais le code génère un message objet malgré tout

Dim X&, I&, tablo, plage As Range, ecart&
Set plage = Data.[A3].CurrentRegion.Columns(1)
tablo = Application.Transpose(plage.Value)
ecart = plage.Row - 1
For I = UBound(tablo) To 1 Step -1
X = Application.Match(tablo(I), tablo, 0)
If X <> I Then Data.Rows(I + ecart).EntireRow.Delete
Next

re
bonsoir
erreur possible N°1
Set plage = Data.[A3].CurrentRegion.Columns(1)
data c'est le codename ou le nom de l'onglet inscrit dans sa poignée?
si c'est le nom inscrit dans sa poignée
donc:
Set plage = sheets("Data").[A3].CurrentRegion.Columns(1)

erreur N°2
If X <> I Then Data.Rows(I + ecart).EntireRow.Delete
une row c'est une row il n'y a pas de moitié ou de quart de row
donc:
If X <> I Then sheets("Data").Rows(I + ecart).Delete Shift=xlup

Merci beaucoup