XL 2010 Doublons de couples de nombres

H

herve02

XLDnaute Nouveau
Bonjour,
J'ai une question sur la façon de faire pour détecter les doublons de couple de nombres ?
Ces couples de nombres sont répartis (pour faire simple) dans 2 colonnes (1 nombre par colonne) et il y a plusieurs centaines de lignes de couple de nombres.
Je cherche un moyen pour que la totalité des doublons soient trouvés, avec indication du nombre de fois qu'apparaît le doublon, et que l'ordre des nombres n'intervienne pas.
Le cas (5,11) est à considérer comme doublon avec le cas (11,5)
Trouver la façon de faire pour 2 colonnes serait déjà bien (à adapter, si possible, plus tard pour plus de 2 colonnes: triplets, ... )

C'est un peu trop compliqué pour moi, j'ai parcouru le forum, j'ai testé avec NB.SI.ENS, mais cela ne donne pas le résultat que je voudrai
Est-ce réalisable ?
Merci pour votre aide

Hervé
 

Pièces jointes

  • Nombre de doublons.xlsx
    10.3 KB · Affichages: 18
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re, salut mapomme,

On peut ne garder que les colonnes A et B avec cette MFC sur ces 2 colonnes :
Code: 
=SOMMEPROD(SIGNE(NBVAL($A1:$B1)*(($A1&" "&$B1=$A$1:$A$1000&" "&$B$1:$B$1000)+($B1&" "&$A1=$A$1:$A$1000&" "&$B$1:$B$1000))))>1
La ligne 1000 est à adapter au besoin.

A+
 

Pièces jointes

  • Nombre de doublons(2).xlsx
    10.8 KB · Affichages: 8
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @herve02 :), @job75 ;),

herve02 à dit:
Par contre ça se complique si je rajoute plus de 2 colonnes 🤒
Il faudrait que les cases soient triées en ordre croissant par avance.
Cliquez pour agrandir...
job75 à dit:
Oui et par formule ce sera difficile, il faudra une macro.
Cliquez pour agrandir...

En VBA. On utilise des collections donc ce doit être compatible PC et MAC (mais je ne peux pas tester sur MAC).

Un essai de fonction générique qui renvoie :
  • soit un tableau à une colonne contenant le nombre d’occurrence de chaque ligne du tableau source
  • soit un tableau à une colonne contenant le texte des index utilisés pour chaque ligne du tableau source afin de compter le nombre d’occurrence de chaque ligne.

  • Le nombre de colonne en entrée est indifférent de 1 à ...
  • les cellules peuvent contenir des nombres ou du texte
  • Si la plage contient du texte alors on ne fait pas la différence entre les majuscules et les minuscules
  • Des cellules de la plage d'entrée peuvent être vides (vide est considéré comme une valeur)

La fonction générique s'appelle Occurrences et admet 1 à 2 arguments en entrée:
Occurences(plage As Range, Optional Texte)​
  1. plage est la plage des données source​
  2. Texte est optionnel : si Texte est absent, alors on retourne le tableau des nombres d’occurrence de chaque ligne sinon on retourne le tableau des textes d'index.​

Pour la démo, le bouton Hop! est associé à la macro Hop() dont le code est dans le module Module1. La démo prend en entrée une plage de 5000 lignes et 4 colonnes.
Le code de la fonction générique Occurrences est aussi dans le module Module1.

Code associé au bouton Hop! :
VB: 
Sub Hop()
   Dim plage As Range, t
   'on peut n'afficher qu'une seule colonne en supprimant la ligne
   ' qui ne nous intéresse pas(ou la mettant en commentaire)
   With Worksheets("Feuil1")
      Set plage = .Range("a1:d" & Cells(Rows.Count, "a").End(xlUp).Row)
      'affichage du nombre d'occurrence dans la colonne E
      t = Occurrences(plage)
      .Cells(plage.Row, "e").Resize(UBound(t), 1) = t
      'affichage des textes d'indexation (le 2ème paramètre est présent - il est quelconque)
      'dans la colonne G
      t = Occurrences(plage, 999)
      .Cells(plage.Row, "g").Resize(UBound(t), 1) = t
   End With
End Sub

Code de la fonction Occurrences() :
VB: 
Function Occurrences(plage As Range, Optional Texte)
Dim collec As New Collection, y, n&, i&, j&
Dim t, ech As Boolean, aux, repet As New Collection, quoi&

   Application.ScreenUpdating = False
   t = plage.Value   'lecture de la plage de valeurs
   'si une seule colonne alors on en rajoute une
   If UBound(t, 2) = 1 Then ReDim Preserve t(1 To UBound(t), 1 To UBound(t, 2) + 1)
   On Error Resume Next 'pour la gestion des collections
   'boucle d'indexation des éléments distincts des valeurs
   For i = 1 To UBound(t)
      For j = 1 To UBound(t, 2)
         y = "": y = collec(LCase(t(i, j)))
         If y = "" Then
            'la valeur n'est pas dans collec
            n = n + 1   'nouvel index
            collec.Add n, LCase(t(i, j))  'on ajoute l'index avec pour clef LCase(t(i, j))
            t(i, j) = n 'on place l'index à la place de la valeur de t(i,j)
         Else
            'la valeur de l'index est déjà dans collec
            t(i, j) = y    'on place cette valeur dans t(i,j)
         End If
      Next j
   Next i
   'les valeurs de t on été maintenant remplacées par leur index (unique pour chaque valeur distincte)
 
   'tri des index de chaque ligne de t (méthode classique par échange)
   For i = 1 To UBound(t)
      Do
         ech = False
         For j = 1 To UBound(t, 2) - 1
            If t(i, j) > t(i, j + 1) Then
               ech = True: aux = t(i, j): t(i, j) = t(i, j + 1): t(i, j + 1) = aux
            End If
         Next j
      Loop Until Not ech
   Next i
   
   For i = 1 To UBound(t)
      'on met dans chaque élément de la première colonne de chaque ligne
      'le texte des index de la ligne (chaque index du texte est entouré avec le caractère "|"
      y = ""
      For j = 1 To UBound(t, 2): y = y & "|" & t(i, j) & "|": Next
      t(i, 1) = y
     
      'puis on se sert de la collection repet pour compter le nombre d'occurrence de chaque texte
      y = "": y = repet(t(i, 1))
      If y = "" Then
         'le texte n'existe pas alors on ajoute 1 à la collection avec la clef texte ( = t(i,1) )
         repet.Add 1, t(i, 1)
      Else
         'la clef texte existe déjà, on la supprime, on la rajoute en incémentant de 1 la valeur existante
         repet.Remove t(i, 1)
         repet.Add y + 1, t(i, 1)
      End If
   Next i
 
   'on place dans la deuxième colonne de t le nombre d'occurrence du texte de la 1ère colonne de t
   For i = 1 To UBound(t): t(i, 2) = repet(t(i, 1)): Next
 
   'Quoi Retourner: Nombre d'occurrence ou bien texte avec les index ?
   If IsMissing(Texte) Then
      'on retourne le nombre d'occurrence
      For i = 1 To UBound(t): t(i, 1) = t(i, 2): Next
   End If
  Occurrences = Application.Index(t, 0, 1)     'on renvoie le tableau désiré
End Function
 

Pièces jointes

  • herve02- Nombre de doublons- v2.xlsm
    125.1 KB · Affichages: 9
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
J'ai ici une fonction qui calcule un indice vers tout tableau à une dimension basé 0 de votre choix, selon un couple de nombres entiers positifs différents. Elle pourrait permettre d'y cumuler le nombre d'occurrences trouvées. Elle est suivie à tout hasard de la fonction inverse renvoyant dans un Variant/Variant(0 To 1) les deux nombres correspondant à un numéro de versus, le plus petit en premier.
VB: 
Public Function VersusJA(ByVal J As Long, ByVal A As Long) As Long
   If A < J Then A = A Xor J: J = J Xor A: A = A Xor J
   If A > J Then VersusJA = A * (A - 3) \ 2 + J Else VersusJA = -1
   If VersusJA < 0 Then Err.Raise 9999, , "VersusJA(" & J & ", " & A & ") impossible."
   End Function
Public Function JAVersus(ByVal VS As Long)
   Dim J As Long, A As Long
   A = Int(Sqr(2 * VS + 0.25) + 1.5)
   J = VS - A * (A - 3) \ 2
   JAVersus = Array(J, A)
   End Function
 
Vote positif 0 Vote négatif
H

herve02

XLDnaute Nouveau
mapomme à dit:
Re,

v2b : version plus complète de ma fonction Occurences.
Cette version permet aux cellules de la plage de contenir une valeur d'erreur de type #N/A, #DIV/0!, #REF!, etc...
Cliquez pour agrandir...
Alors là Bravo, ça fonctionne, je ne sais pas comment car ça me dépasse.
Beau travail 👍
Pour le nombre de lignes, cela ira largement, pour le nombre de colonnes j'aurai juste besoin de savoir où modifier cela en cas de besoin.
Merci
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour herve02, mapomme, Bernard,

Perso j'utiliserai simplement cette fonction VBA :
VB: 
Function Xconcat(r As Range)
Dim a(), i&, v
ReDim a(r.Count - 1) 'base 0
For i = 0 To UBound(a)
    v = CStr(r(i + 1))
    If IsNumeric(v) Then a(i) = CDbl(v) Else a(i) = v
Next
tri a, 0, i - 1
Xconcat = Join(a, Chr(1))
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Le code est à placer impérativement dans un module standard.

La fonction est utilisée en colonne E du fichier joint.

A+
 

Pièces jointes

  • Xconcat(1).xlsm
    70.5 KB · Affichages: 12
Dernière édition:
Vote positif 0 Vote négatif
H

herve02

XLDnaute Nouveau
job75 à dit:
Bonjour herve02, mapomme, Bernard,

Perso j'utiliserai simplement cette fonction VBA :
VB: 
Function Xconcat(r As Range)
Dim a(), i&, v
ReDim a(r.Count - 1) 'base 0
For i = 0 To UBound(a)
    v = CStr(r(i + 1))
    If IsNumeric(v) Then a(i) = CDbl(v) Else a(i) = v
Next
tri a, 0, i - 1
Xconcat = Join(a, Chr(1))
End Function

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Le code est à placer impérativement dans un module standard.

La fonction est utilisée en colonne E du fichier joint.

A+
Cliquez pour agrandir...

Bonjour Job75
Oui, cette solution me plait beaucoup, elle est de plus facilement modifiable.

Merci
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Problème de non-doublons
Réponses
6
Affichages
247
merinos
merinos
D
  • Question
Microsoft 365 Cas réel - avec problème complexe sur de la prevision de match en evitant les doublons
Réponses
1
Affichages
287
Dock91
D
E
  • Question
XL 2019 Identification des doublons sur la base des attributs de produits
Réponses
3
Affichages
531
ExcelBeginner
E
T
  • Résolu(e)
XL 2016 Idées pour recherche de doublons complexe
2
Réponses
17
Affichages
1 K
Tom33700
T
D
  • Résolu(e)
Microsoft 365 Supprimer doublons sans supprimer les formules
Réponses
2
Affichages
701
damsleretour
D
M
  • Résolu(e)
XL 2019 Afficher une valeur grâce à index(equiv))
Réponses
4
Affichages
391
AtTheOne
AtTheOne
Markoko
  • Résolu(e)
XL 2016 Détecter des doublons dans une colonne de 400.000 lignes
2 3
Réponses
30
Affichages
3 K
eriiic
eriiic
B
  • Question
XL 2016 Doublons - Remonter sur une seule ligne en créant de nouvelles colonnes
Réponses
9
Affichages
469
Benskyy
B
Lu76Fer
  • Sondage
XLS : Arbre de Recherche BinaiRe Equilibré ou Arbre AVL
Réponses
7
Affichages
327
Lu76Fer
Lu76Fer
C
  • Question
Microsoft 365 Recherche valeurs dans une colonne / doublons
Réponses
5
Affichages
813
Casim
C

Membres actuellement en ligne

5 membres et 32 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16