XL 2016 Compter les doublons

Rabeto

XLDnaute Occasionnel
Bonjour,

Je souhaite compter les doublons sans compter le premier doublon qui apparaît de la liste de chaque critère, càd, si il y a 3 valeurs en double pour X personnes, mettre 1 sur les 2 autres valeur et rien sur le premier valeur en double et pour la 2eme colonne, mettre 1 sur les valeurs en double, et rien sur le premier valeur.

Merci,
 

Pièces jointes

  • Doublon.xlsx
    9.7 KB · Affichages: 9
Solution
Bonjour Rabeto, JHA,
@job75, est il possible de mettre ce genre de formule en macro VBA
Bien sûr, c'est très classique, voyez le fichier joint et la macro dans le code de la feuille :
VB:
Private Sub Worksheet_change(ByVal target As Range)
Dim d As Object, tablo, i&, x$, y$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [A1].CurrentRegion.Resize(, 4)
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        tablo(i, 3) = "": tablo(i, 4) = "" 'RAZ
        x = tablo(i, 2)
        y = x & tablo(i, 1)
        If d.exists(x) Then tablo(i, 4) = 1 Else d(x) = ""
        If d.exists(y) Then tablo(i, 3) = 1 Else d(y) = ""
    Next
    '---restitution---...

job75

XLDnaute Barbatruc
Bonjour Rabeto, JHA,

Ce n'est pas très clair, il aurait fallu indiquer les résultats attendus.

D'après ce que je comprends, formule matricielle en C2 :
Code:
=N(EQUIV(A2&B2;A$1:A$22&B$1:B$22;0)<LIGNE())
Formule normale en D2 :
Code:
=N(EQUIV(B2;B$1:B$22;0)<LIGNE())
A+
 

Pièces jointes

  • Doublon(1).xlsx
    11.4 KB · Affichages: 10

Rabeto

XLDnaute Occasionnel
Bonjour à tous,

Merci pour vos réponses, celle de Job75 a bien répondu ma demande, celui de JHA, je l'ai appliqué sur autre besoin et ça marche.

@job75, est il possible de mettre ce genre de formule en macro VBA, et de n'avoir que les résultats en valeur dans les colonnes, les formules matricielles génèrent une lenteur grave surtout si il y a plusieurs ligne.

Merci,
 

job75

XLDnaute Barbatruc
Bonjour Rabeto, JHA,
@job75, est il possible de mettre ce genre de formule en macro VBA
Bien sûr, c'est très classique, voyez le fichier joint et la macro dans le code de la feuille :
VB:
Private Sub Worksheet_change(ByVal target As Range)
Dim d As Object, tablo, i&, x$, y$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [A1].CurrentRegion.Resize(, 4)
    tablo = .Value 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        tablo(i, 3) = "": tablo(i, 4) = "" 'RAZ
        x = tablo(i, 2)
        y = x & tablo(i, 1)
        If d.exists(x) Then tablo(i, 4) = 1 Else d(x) = ""
        If d.exists(y) Then tablo(i, 3) = 1 Else d(y) = ""
    Next
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Value = tablo
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

Elle est très rapide car elle utilise un tableau VBA et 1 Dictionary.

Notez que les résultats en colonnes C et D ne peuvent pas être modifiés manuellement.

A+
 

Pièces jointes

  • Doublon VBA(1).xlsm
    17 KB · Affichages: 11
Dernière édition:

Rabeto

XLDnaute Occasionnel
Bonjour job75,

J'ai étudié le code, mais je n'arrive pas à le modifier, 😥 je veux juste l'adapter à mon fichier original, et faire juste le calcul de la colonne D mettre dans une colonne M.

Pouvez vous m'indiquer ce qui est à modifier dans ce cas svp,

merci,
 

job75

XLDnaute Barbatruc
Bonjour Rabeto, le forum,

Je viens de corriger mon post #6 car j'avais déclaré inutilement un 2ème Dictionary.

Pour ce nouveau problème voyez ce fichier (2) et la macro :
VB:
Private Sub Worksheet_change(ByVal target As Range)
Dim d As Object, tablo, ub&, i&, resu1(), resu2(), x$, y$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With [A1].CurrentRegion
    tablo = .Resize(, 2) 'matrice, plus rapide
    ub = UBound(tablo)
    ReDim resu1(1 To ub, 1 To 1)
    ReDim resu2(1 To ub, 1 To 1)
    For i = 2 To ub
        x = tablo(i, 2)
        y = x & tablo(i, 1)
        If d.exists(x) Then resu1(i, 1) = 1 Else d(x) = ""
        If d.exists(y) Then resu2(i, 1) = 1 Else d(y) = ""
    Next
    '---restitution---
    resu1(1, 1) = .Cells(1, 13): resu2(1, 1) = .Cells(1, 3) 'titres
    Application.EnableEvents = False 'désactive les évènements
    .Cells(1, 13).Resize(ub) = resu1
    .Cells(1, 3).Resize(ub) = resu2
    Union(.Cells(1, 13).Resize(ub), .Cells(1, 3).Resize(ub)).Borders.Weight = xlThin 'bordures
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
Il y a 2 tableaux VBA pour les résultats en colonnes C et M.

A+
 

Pièces jointes

  • Doublon VBA(2).xlsm
    18.9 KB · Affichages: 9

Discussions similaires

Réponses
10
Affichages
390

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla