Isoler et compter les valeurs en doublons

Monky

XLDnaute Nouveau
Bonsoir,

Je souhaiterais isoler et compter les occurrences en doublons dans une base dans le but d'alimenter un système d'information géographique que ne gère pas les relations 1 ; n.

Voici un exemple que ce que je peux trouver dans cette base :
rue ; ref
1 allée de la croix rouge ; 0H0524
1 allée de la croix rouge ; 0H0524
3 allée de la croix rouge ; 0H0525
7 allée de la croix rouge ; 0H0738
7 allée de la croix rouge ; 0H0738
7 allée de la croix rouge ; 0H0738

Je souhaiterais avoir comme résultat ceci :
1 allée de la croix rouge ; 0H0524 ; 2
3 allée de la croix rouge ; 0H0525 ; 1
7 allée de la croix rouge ; 0H0738 ; 3

En quelque sorte effacer (ou archiver) les doublons et compter toutes les occurrences. Je connais mdf doublon qui est parfait mais je n'arrive malheureusement pas à trouver un moyen de chiffrer les doublons.

Merci par avance pour vos idées,
 

job75

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Bonsoir Monky, JC, CISCO,

Je comprends que rue et ref sont dans la même cellule.

Alors voyez le fichier joint avec cette formule matricielle en B2 :

Code:
=SI(LIGNES(A$2:A2)>SOMMEPROD(1/NB.SI(A$2:A$7;A$2:A$7));"";INDEX(A:A;MIN(SI(NB.SI(B$1:B1;A$2:A$7&" ; *")=0;LIGNE(A$2:A$7))))&" ; "&NB.SI(A$2:A$7;INDEX(A:A;MIN(SI(NB.SI(B$1:B1;A$2:A$7&" ; *")=0;LIGNE(A$2:A$7))))))
A valider bien sûr par Ctrl+Maj+Entrée.

A+
 

Pièces jointes

  • Classeur(1).xls
    23 KB · Affichages: 128
  • Classeur(1).xls
    23 KB · Affichages: 135
  • Classeur(1).xls
    23 KB · Affichages: 132

ROGER2327

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Bonjour à tous
Une petite procédure dans le classeur joint.
(Peut-être à adapter si la structure des données n'est pas exactement celle que j'ai supposée : un petit classeur aurait évité 1) toute ambigüité ; 2) la perte de temps à reconstituer les données.)​
ROGER2327
#5156


Vendredi 6 Clinamen 138 (Saint Ganymède, professionnel, SQ)
8 Germinal An CCXIX
2011-W13-1T01:23:22Z

———————————
Le code fourni est erronné. Je supprime la pièce jointe. Voir le message #10.
———————————
 
Dernière édition:

laetitia90

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

bonjour tous
également par macro suppose les données de a2 a a(x)
 

Pièces jointes

  • Classeur1.zip
    12.4 KB · Affichages: 87
  • Classeur1.zip
    12.4 KB · Affichages: 86
  • Classeur1.zip
    12.4 KB · Affichages: 86
Dernière édition:

david84

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Bonjour à tous,
pour compléter le tout, ci-joint une version formules si les rues et les ref ne sont pas dans la même cellule (utilisation du fichier de Roger que je remercie).
Maintenant, Monky a l'embarras du choix (mais la prochaine fois, penser à poster un fichier exemple).
A+
 

Pièces jointes

  • Compter_les_doublons_160515.xls
    35.5 KB · Affichages: 149
  • Compter_les_doublons_160515.xls
    35.5 KB · Affichages: 154
  • Compter_les_doublons_160515.xls
    35.5 KB · Affichages: 153

job75

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Bonjour le fil,

Maintenant, Monky a l'embarras du choix

Oui et ce n'est pas fini d'ailleurs.

Dans le cas où les données sont dans des cellules différentes, utilisation de la formule matricielle de mon post #4 en VBA.

Bien sûr c'est pour le fun, mais enfin...

Edit : je n'avais pas mis assez d'arguments pour la commande Convertir (TextToColumns).

A+
 

Pièces jointes

  • Classeur(2).xls
    39.5 KB · Affichages: 109
  • Classeur(2).xls
    39.5 KB · Affichages: 114
  • Classeur(2).xls
    39.5 KB · Affichages: 104
Dernière édition:

david84

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Re
Une déclinaison de la proposition Dictionnary de Laetitia:) :
Code:
Sub test()
Dim m As Object, c As Range
a = Sheets("Test").Range("A1").CurrentRegion.Value
  Set mondico = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    mondico(a(i, 1) & " " & a(i, 2)) = mondico(a(i, 1) & " " & a(i, 2)) + 1
  Next
[C1].Resize(mondico.Count, 1) = Application.Transpose(mondico.Keys)
[D1].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
End Sub
A+
 

Pièces jointes

  • Doublons.xls
    46 KB · Affichages: 103
  • Doublons.xls
    46 KB · Affichages: 109
  • Doublons.xls
    46 KB · Affichages: 105

ROGER2327

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Bonjour à tous
Une erreur s'est glissée dans le code donné plus tôt.
Voici le classeur corrigé et le code correct :
VB:
Sub toto() 'La bibliothèque Microsoft Scripting Runtime (scrrun.dll) doit être référencée.
Dim i&, j%, k%, TmpS$, TmpD(), DT(), SD As Scripting.Dictionary, wf As WorksheetFunction
  Set wf = Application.WorksheetFunction
  Set SD = New Dictionary
  DT = Sheets(1).Range("DT").Value 'Plage de données.
   k = UBound(DT, 2)
  ReDim TmpD(k)
  For i = 1 To UBound(DT, 1)
    For j = 1 To 2: TmpS = TmpS & CStr(DT(i, j)) & "#": Next 'Clef de sélection : les deux premiers champs.
     If Len(TmpS) >= j Then
      If SD.Exists(TmpS) Then
        TmpD = SD(TmpS)
        TmpD(k) = TmpD(k) + 1
        SD(TmpS) = TmpD
      Else
        For j = 1 To k: TmpD(j - 1) = DT(i, j): Next
        TmpD(k) = 1&
        SD(TmpS) = TmpD
      End If
    End If
    TmpS = Space(0)
  Next
  Erase DT, TmpD
  With Sheets(2).Range("ST") 'Première cellule de la plage de résultats.
     .Value = Space(0)
    .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).Row, k + 1).ClearContents
    If SD.Count Then .Resize(SD.Count, k + 1).Value = wf.Transpose(wf.Transpose(SD.Items))
  End With
  Set wf = Nothing
  Set SD = Nothing
End Sub
ROGER2327
#5157


Vendredi 6 Clinamen 138 (Saint Ganymède, professionnel, SQ)
8 Germinal An CCXIX
2011-W13-1T09:00:36Z
 

Pièces jointes

  • Compter_les_doublons_160515.xls
    19.5 KB · Affichages: 117
  • Compter_les_doublons_160515.xls
    19.5 KB · Affichages: 122
  • Compter_les_doublons_160515.xls
    19.5 KB · Affichages: 117

job75

XLDnaute Barbatruc
Re : Isoler et compter les valeurs en doublons

Re,

Encore une ! Nettement plus simple avec le filtre élaboré (avancé) :

Code:
Sub CompteDoublons()
Dim plage As Range, a1$, a2$
[C:IV].ClearContents
Set plage = Range("A1:B" & [A65536].End(xlUp).Row)
plage.AdvancedFilter xlFilterCopy, [C1], plage.Offset(, 2), True
a1 = plage.Columns(1).Address(ReferenceStyle:=xlR1C1)
a2 = plage.Columns(2).Address(ReferenceStyle:=xlR1C1)
With plage.Offset(, 4).Resize(, 1)
  .FormulaR1C1 = "=SUMPRODUCT((RC[-2]=" & a1 & ")*(RC[-1]=" & a2 & "))"
  .Value = .Value
  .Replace 0, "", xlWhole
  .Resize(1) = "Nombre"
End With
End Sub
A+
 

Pièces jointes

  • Classeur(3).xls
    40 KB · Affichages: 134
  • Classeur(3).xls
    40 KB · Affichages: 135
  • Classeur(3).xls
    40 KB · Affichages: 143
Dernière édition:

Discussions similaires

Réponses
10
Affichages
423

Statistiques des forums

Discussions
312 836
Messages
2 092 651
Membres
105 479
dernier inscrit
chaussadas.renaud