Afficher doublon essentiellement

[BRUNO62]

Bonsoir,

J'ai besoin d'aide.
Ci-joint ma demande
Avez vous une solution ?
Merci, d'avance
A+

 

[ROGER2327]

Re : Afficher doublon essentiellement

Bonsoir BRUNO62

Peut-être ceci :

[COLOR="DarkSlateGray"][B]Sub toto()
Dim plage As Range, tableau
   Set plage = Range("A2:A" & Range("A65536").End(xlUp).Row)
   tableau = plage.Value
   For i = 1 To UBound(tableau, 1)
      Select Case WorksheetFunction.CountIf(plage, tableau(i, 1))
      Case 2
         For j = i + 1 To UBound(tableau, 1)
            If tableau(i, 1) = tableau(j, 1) Then tableau(j, 1) = "": Exit For
         Next
      Case Else: tableau(i, 1) = ""
      End Select
   Next
   plage.Offset(0, 1) = tableau
End Sub[/B][/COLOR]

ROGER2327
#3484

26 Floréal An CCXVIII
2010-W19-6T22:04:01Z

 

[Robert]

Re : Afficher doublon essentiellement

Bonsoir Bruno, Roger, bonsoir le forum,

Roger frappe toujours vite et juste... Un modèle ! Je me permet quand même d'envoyer ma proposition avec la macro ci-dessous et j'essaie de comprendre et d'assimiler la sienne :

Option Explicit 'oblige à déclarer toutes les variables
Sub toto()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim x As Byte 'déclare la variable x (incrément de variable)
Dim tb() As Integer 'déclare le tableau de variables tb (TaBleau)
Dim y As Integer 'déclare la variable y (incrément de varriable)
 
Set pl = Range("A2:A" & Range("A65536").End(xlUp).Row) 'définit la plage pl
 
'********************************************
'première variable du tableau de variables tb
'********************************************
For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
    'condition : si la valeur de la cellule cel existe plus d'une fois dans la plage pl
    If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
        ReDim Preserve tb(x) 'redimensionne le tableau tb
        tb(x) = cel.Value 'attribue la première variable
        cel.Offset(0, 1).Value = cel.Value 'copie la valeur de cel en colonne B
        Exit For 'sort de la boucle
    End If 'fin de la condition
Next cel 'prochaine cellule de la boucle 1
 
'*******************************************
'autres variables du tableau de variables tb
'*******************************************
For Each cel In pl 'boucle 1 : sur toutes les cellules cel de la plage pl
    'condition : si la valeur de la cellule cel existe plus d'une fois dans la plage pl
    If Application.WorksheetFunction.CountIf(pl, cel.Value) > 1 Then
        For y = 0 To UBound(tb) 'boucle 2 : sur toutes les variables indexées du tableau tb
            'si la valeur de la cellule est égale à la variable indexée de tb, va à l'étiquette "suite" (sans ajout de variables)
            If cel.Value = tb(y) Then GoTo suite
        Next y 'prochaine variable indexée de la boucle 2
 
        cel.Offset(0, 1).Value = cel.Value 'copie la valeur de cel en colonne B
        x = x + 1 'incrémente la variable x
        ReDim Preserve tb(x) 'redimensionne le tableau de variable tb
        tb(x) = cel.Value 'ajoute une nouvelle variable indexée au tableau tb
    End If 'fin de la condition
 
suite: 'étiquette
Next cel 'prochaine cellule de la boucle 1
End Sub

 

[ROGER2327]

Re : Afficher doublon essentiellement

Re...

Pas si sûr d'avoir visé juste !
Ma procédure conserve uniquement un exemplaire des éléments en double, mais élimine les éléments uniques et aussi les éléments multiples en nombre supérieur à deux.
Pour faire la même chose que vous, je dois modifier ainsi :

[COLOR="DarkSlateGray"]Sub toto()
Dim plage As Range, tableau
   Set plage = Range("A2:A" & Range("A65536").End(xlUp).Row)
   tableau = plage.Value
   For i = 1 To UBound(tableau, 1)
      Select Case WorksheetFunction.CountIf(plage, tableau(i, 1))
      Case [COLOR="Red"]Is > 1[/COLOR]
         For j = i + 1 To UBound(tableau, 1)
            [COLOR="Red"]If tableau(i, 1) = tableau(j, 1) Then tableau(j, 1) = ""[/COLOR]
         Next
      Case Else: tableau(i, 1) = ""
      End Select
   Next
   plage.Offset(0, 1) = tableau
End Sub[/COLOR]

ROGER2327
#3485

26 Floréal An CCXVIII
2010-W19-6T22:44:04Z

 

[BOISGONTIER]

Re : Afficher doublon essentiellement

Bonjour,

  For i = [A65000].End(xlUp).Row To 2 Step -1
    If Cells(i, 1) <> Cells(i - 1, 1) And Application.CountIf([a:a], Cells(i, 1)) > 1 Then Cells(i, 2) = Cells(i, 1)
  Next i

JB

 

[BRUNO62]

Re : Afficher doublon essentiellement

Bonjour,

Merci, à ROGER2327 BOISGONTIER Robert.
C'est ok !
Bon dimanche.
A+

 

[hoerwind]

Re : Afficher doublon essentiellement

Bonjour, salut les autres,

Une macro c'est bien, mais une toute petite formule fait tout aussi bien l'affaire.

B2 et à copier vers le bas :

=SI(OU(NB.SI(A2:A9;A2)=1;NB.SI(A$2:A2;B1)>0);"";A2)

 

[Tibo]

Re : Afficher doublon essentiellement

Salut hoerwind,

C'est également ce que je m'étais dit.

Je t'accompagne dans la voie formule en proposant celle-ci en B2 :

=SI(NB.SI(A2:$A$9;A2)>1;A2;"")

à recopier vers le bas

@+

 

[hoerwind]

Re : Afficher doublon essentiellement

Salut Tibo,

Si ce n'est vrai en toutes choses, les plus courtes sont toujours les meilleures.
Je m'incline (bien bas).

 

[Robert]

Re : Afficher doublon essentiellement

Bonsoir le fil, bonsoir le forum,

Hulk ! Tu n'es plus le seul... Je suis vert moi aussi ! Vert de honte quand je vois ce que font nos amis. C'est plus de la formule ça ! C'est carrément de la Formule 1 !

 

[david84]

Re : Afficher doublon essentiellement

Bonsoir à tous,
=SI(ET(A2=A3;A2<>"");A2;"")
donne également le résultat escompté par rapport à l'exemple fourni.
A+

 

[ROGER2327]

Re : Afficher doublon essentiellement

Bonsoir à tous

Sept solutions différentes dont pas deux ne donnent le même résultat !
Un essai comparatif s'impose...​

ROGER2327
#3486

27 Floréal An CCXVIII
2010-W19-7T20:50:10Z

 

[Tibo]

Re : Afficher doublon essentiellement

Bonjour,

La taille de l'échantillon fourni par Bruno était de nature à permettre différentes interprétations.

Une autre solution formule, qui donne les mêmes résultats que la version 2 de Roger :

=SI(ET(NB.SI($A:$A;A2)>1;NB.SI($A$2:A2;A2)=1);A2;"")

à recopier vers le bas

@+

 

[hoerwind]

Re : Afficher doublon essentiellement

Bonjour Roger, salut Tibo et les autres,

Merci pour le tableau comparatif, très instructif, mais ...

Pour que la comparaison soit fiable il faudrait que l'extension de la plage de données réponde aux mêmes critères que ceux qui peuvent être déduits de l'exemple initial, c'est à dire :
- pas de cellules vides
- des doublons groupés
- pas de valeurs alphabétiques
- pas plus de deux valeurs identiques

Pour ma part, le comparatif sur l'extension des données répond à une autre question que celle posée initialement.

 

[david84]

Re : Afficher doublon essentiellement

Bonjour,
d'accord avec Roger. C'est d'ailleurs pour cela que j'avais précisé "par rapport à l'exemple fourni". Il faudrait donc que bruno62 précise d'avantage sa demande.