Microsoft 365 Copie doublons

[Francky79]

Bonjour,

Je ne trouve pas de formule pouvant copier les doublons de la colonne A les coller dans la colonne C et en face de chaque doublons trouvés mettre le nombre de doublons.
Voir en ci-dessous.

Merci pour votre aide

 

[JHA]

Bonjour à tous,

Un exemple par formule

JHA

 

[sylvanu]

Bonjour Francky, JHA,
Un peu à labour comme d'hab.

Un essai en PJ avec :

=SIERREUR(INDEX(Liste;EQUIV(0;NB.SI(C3:$C$3;Liste)+SI(NB.SI(Liste;Liste)>1;0;1);0));"")
( à valider en matriciel par Maj+Ctrl+Entrée )
et
=SI(NB.SI(Liste;C4)=0;"";NB.SI(Liste;C4))

 

[Francky79]

Merci a vous deux j'essaie de comprendre si trop compliqué pour moi je reviendrai vers vous.

Bonne journée

 

[JHA]

Bonjour à tous,

Très simple et sans formule avec Power Query

JHA

 

[mapomme]

Bonjour à tous ,

Encore plus simple avec O365 : une formule unique dans une seule cellule .
=LET(Y;A2:A9999;X;TRIER(UNIQUE(FILTRE(Y;(Y<>"")*(NB.SI(Y;Y)>1))));ASSEMB.H(X;NB.SI(Y;X)))

nota : vous pouvez adapter le "9999" dans la formule. La seule contrainte est que ce nombre doit être supérieur au plus grand numéro de ligne possible de votre plage source.


Grâce au LET :
On attribue au paramètre Y la plage : A2:A9999

Puis on attribue au paramètre X le filtre de la plage Y en ne gardant que les cellules non vides (Y<>"") et en ne gardant que ceux qui sont doublons (NB.SI(Y;Y)>1).
Ce qui donne la condition du filtre : (Y<>"") * (NB.SI(Y;Y)>1) soit FILTRE(Y;(Y<>"")*(NB.SI(Y;Y)>1))
On ne prend dans le résultat que les lignes pas en doublon. En effet si un élément est présent trois fois par exemple, on va le trouver trois fois dans la plage filtrée car à chacune de ses apparitions dans la plage le nombre d'occurrence est supérieur 1 (et même égal à trois) et donc répond au filtre...
soit UNIQUE(FILTRE(Y;(Y<>"")*(NB.SI(Y;Y)>1)))
On termine avec le tri de ce résultat: TRIER(UNIQUE(FILTRE(Y;(Y<>"")*(NB.SI(Y;Y)>1))))

A ce stade, on a la colonne avec la liste triée des doublons (argument X).
il nous reste à ajouter à droite le nombre des doublons pour chaque élément de X :
On a la liste X => le nombre des doublons pour chacun des éléments de la liste X au sein de la plage Y est NB.SI(Y;X)

Mettons côte à côte la liste X des doublons et la liste de leurs occurrences respectives via la fonction ASSEMB.H() soit ASSEMB.H(X;NB.SI(Y;X)))

Et on arrive à la formule :
=LET(Y;A2:A9999;X;TRIER(UNIQUE(FILTRE(Y;(Y<>"")*(NB.SI(Y;Y)>1))));ASSEMB.H(X;NB.SI(Y;X)))

La seule chose à faire pour adapter la formule à votre cas particulier est de coller la formule dans une cellule et de définir la plage Y dans cette formule en modifiant la plage source A2:A9999)

Si aucun doublon n'est présent, vous obtiendrait l'erreur #CALC!. Si vous désirez la traiter, enchâsser la formule dans un SIERREUR soit SIERREUR( Formule ; aucun doublons" ) ou SIERREUR( Formule ; "" )

Formules dynamiques d'O365 :
Si une des cellules où doit s'afficher le résultat de la formule n'est pas vide ou bien semble être vide mais contient le fameux caractère "chaine vide" alors Excel affiche "#PROPAGATION !".
Excel vous avertit qu'il ne peut pas afficher le résultat dans son intégralité car il a trouvé au moins une cellule non vide dans la zone des résultats que la formule doit afficher. Pour remédier à ce problème, effacer bien les cellules de la zone possible d'affichage (sélectionner cette zone puis tapez Suppr).

 

[mapomme]

Re,

Pour O365, une formule plus efficace et plus compréhensible :
=LET(Y;A2:A9999;X;TRIER(UNIQUE(FILTRE(Y;Y<>""))); Z; FILTRE(X;NB.SI(Y;X)>1); W;NB.SI(Y;Z);ASSEMB.H(Z;W))

Question : je ne me suis pas encore consacré à l'apprentissage de Power Query mais j'ai l'impression que le raisonnement pour la requête PQ est du même ordre que que celui de la formule O365, non ?

Rigolo : avec les flèches qui ne sont pas parallèles, on a quelquefois un effet d'optique laissant croire que ce sont les lignes de texte qui ne sont pas parallèles...

 

[job75]

Bonjour à tous,

Une solution VBA très classique avec le Dictionary :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, d As Object, i&, v, e, n&, resu(), a, b
tablo = Range("A1:B" & Cells.SpecialCells(xlCellTypeLastCell).Row) 'matrice, plus rapidee, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    v = tablo(i, 1)
    If v <> "" Then d(v) = d(v) + 1
Next i
For Each e In d.keys
    If d(e) = 1 Then d.Remove e
Next e
n = d.Count
'---transposition---
If n Then
    ReDim resu(1 To n, 1 To 2)
    a = d.keys: b = d.items
    For i = 1 To n
        resu(i, 1) = a(i - 1): resu(i, 2) = b(i - 1)
    Next
End If
'---restitution---
Application.EnableEvents = False
With [C4] '1ère cellule de destination
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True
End Sub

Le code s'exécute quand on modifie ou valide une cellule quelconque.

J'ai testé en recopiant la plage A4:A13 sur 100 000 lignes : l'exécution se fait en 0,23 seconde.

A+

 

[mapomme]

Bonjour à tous ,

Un autre code très rapide. Le tableau final est trié. Pas d'utilisation de dictionary.

Cliquer d'abord sur le bouton orange INIT pour initialiser les 100 000 lignes de données (avec des nombres compris entre 1 et 25 000).

Le code dans le module de Feuil1 :

Sub Test_mapomme()
Dim der&, t, i0&, i&, debut
   debut = Timer
   Application.ScreenUpdating = False
   With Sheets("Feuil1")
      ' préparation
      If FilterMode Then .ShowAllData
      der = .Cells(Rows.Count, "a").End(xlUp).Row
      .Range("c2:d2").Resize(Rows.Count - 1).Clear
      ' copie de la source vers colonne C puis tri de la colonne C
      .Range("a2:a" & der).Copy Range("c2")
      .Range("c1").Resize(der).Sort Key1:=[c1], order1:=xlAscending, Header:=xlYes
      der = .Cells(Rows.Count, "c").End(xlUp).Row
      ' lecture des colonne C à D dans un tableau
      t = .Range("c1").Resize(der + 1, 2)
      ' parcours du tableau t pour compter les occurences
      i0 = 2: t(i0, 2) = 1
      For i = 3 To UBound(t)
         If t(i, 1) = t(i0, 1) Then
            t(i0, 2) = t(i0, 2) + 1
         Else
            i0 = i
            t(i0, 2) = 1
         End If
      Next i
      ' parcours du tableau t pour regrouper les doublons dans le haut du tableau
      i0 = 1
      For i = 2 To UBound(t) - 1
         If t(i, 2) > 1 Then i0 = i0 + 1: t(i0, 1) = t(i, 1): t(i0, 2) = t(i, 2)
      Next i
      ' affichage du résultat
      .Range("c2:d2").Resize(Rows.Count - 1).Clear
      If i0 > 1 Then .Range("c1:d1").Resize(i0, 2) = t
   End With
   MsgBox Format(Timer - debut, "0.001\ sec.")
End Sub

 

[Francky79]

Bonjour,
Merci a tous pour vos solutions.
Je prendrais bien la solution de job75 elle correspond parfaitement a mon besoin mais,
il y a déjà un évènement dans mon Worksheet_Change comment faire cohabiter les deux ?
Voir code ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)
' Code déja dans Worksheet_Change
Dim i&
Set Target = Intersect(Target, [V:V], UsedRange)
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With Feuil3 'CodeName à adapter
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    For Each Target In Target 'si entrées/effacements multiples
        If Target.Row > 1 Then
            If LCase(Target) = "t" Then
                i = 0
                i = Application.Match(Target(1, 0), .Columns(1), 0)
                If i = 0 Then i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: .Cells(i, 1) = Target(1, -20)
                'Hyperlinks.Add Target(1, 2), "", .Name & "!" & .Cells(i, 1).Address(0, 0), TextToDisplay:="OA"
            ElseIf Target = "" Then
                Target(1, 2).Clear 'RAZ
                .Rows(Application.Match(Target(1, -19), .Columns(1), 0)).Delete
            End If
        End If
    Next
End With
[V:V].HorizontalAlignment = xlCenter 'centrage
    Application.EnableEvents = True 'réactive les évènements
    
' Code pour doublons
Dim tablo, d As Object, i&, v, e, n&, resu(), a, b
tablo = Range("A1:B" & Cells.SpecialCells(xlCellTypeLastCell).Row) 'matrice, plus rapidee, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    v = tablo(i, 1)
    If v <> "" Then d(v) = d(v) + 1
Next i
For Each e In d.keys
    If d(e) = 1 Then d.Remove e
Next e
n = d.Count
'---transposition---
If n Then
    ReDim resu(1 To n, 1 To 2)
    a = d.keys: b = d.items
    For i = 1 To n
        resu(i, 1) = a(i - 1): resu(i, 2) = b(i - 1)
    Next
End If
'---restitution---
Application.EnableEvents = False
With [C4] '1ère cellule de destination
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
Application.EnableEvents = True
End Sub

Merci encore pour votre aide

 

[job75]

Bonjour Francky79, le forum,

Je prendrais bien la solution de job75 elle correspond parfaitement a mon besoin mais,
il y a déjà un évènement dans mon Worksheet_Change comment faire cohabiter les deux ?

Il n'y a aucun problème, simplement dans le 2ème code ne déclarez pas une 2ème fois la variable i.

A+