XL 2016 Nombre de livraisons par client

poutch12

XLDnaute Nouveau
Bonjour,

J'ai une base de données excel, avec trois colonnes :
- Une colonne indiquant le code client de chaque client
- Le bon de livraison de chaque client


Mon objectif est de savoir le nombre de bons de livraison par client. Sachant que, dans les deux colonnes, il y a des doublons.
Ce que j'ai fait jusqu'ici :

J'ai créé une troisième colonne avec les codes clients sans doublons. Puis j'ai utilisé cette formule :
=sommeprod((1/NB.SI(plage bons de livraison; plage bons de livraisons))*(cellule code client dans colonne triée=plage codes clients avec doublons))

J'ai essayé cette formule sur un bout de la base de données, et elle marche. Cependant, ma BDD étant grande (centaines de milliers de lignes), la formule fait bugger excel quand j'essaie de la lancer sur toute la base de données.

Auriez-vous une autre solution pour aboutir au résultat ?

Merci pour votre aide.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Une version VBA (assez rapide) sans dictionary ( puisque @pierrejean ;) y travaille ou pas ??? )
Le code dans le module de Feuil1:
VB:
Sub Compter_Unique()
Dim t0, t, n&, i&, ref, nbr&
  t0 = Timer
  Application.ScreenUpdating = False
  t = Range("a1:b" & Cells(Rows.Count, "a").End(xlUp).Row)
  Range("f:g").Clear
  Range("f:g").Resize(UBound(t)) = t
  Range("f:g").Resize(UBound(t)).Sort key1:=Range("f1"), order1:=xlAscending, key1:=Range("g1"), order2:=xlAscending, Header:=xlYes
  Range("f:g").Resize(UBound(t)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
  t = Range("f1:g" & Cells(Rows.Count, "a").End(xlUp).Row)
  n = 2: ref = t(2, 1): nbr = 0
  For i = 2 To UBound(t)
    If t(i, 1) = ref Then
      nbr = nbr + 1
    Else
      t(n, 1) = ref: t(n, 2) = nbr
      nbr = 1: ref = t(i, 1): n = n + 1
    End If
  Next i
  t(n, 1) = ref: t(n, 1) = nbr
  Range("f:g").Clear: Range("f:g").Resize(n - 1) = t
  Range("f:g").EntireColumn.AutoFit: Range("f1:g1").Interior.Color = RGB(200, 200, 255)
  MsgBox "Terminé en: " & Format(Timer - t0, "0.00\ sec.")
End Sub
edit: bonjour @BrunoM45 :). J'avais point vu le doublon sur Excel-pratique.
 

Pièces jointes

  • poutch12- bdl- v1.xlsm
    154.7 KB · Affichages: 8
Dernière édition:

Amilo

XLDnaute Accro
Re,
J'ai appliqué la solution power query sur le fichier à mapomme et j'obtiens le même résultat que mapomme

Edit : merci Bruno45 pour le lien multiposte :)
Bonne journée
 

Pièces jointes

  • poutch12- bdl- v1.xlsm
    158.3 KB · Affichages: 5
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Si poutch12 est sur MAC le Dictionary ne fonctionnera pas.

Dans le fichier joint voici donc une solution qui utilise 3 collections :
VB:
Sub NbreDeBdlParClient()
Dim tablo, resu(), i&, cle1$, Collec1 As New Collection, n&, CollecN As New Collection, cle2, Collec2 As New Collection, lig&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 2)
For i = 2 To UBound(tablo, 1)
    cle1 = tablo(i, 1)
    On Error Resume Next
    Collec1.Add cle1, cle1
    If Err = 0 Then
        n = n + 1
        resu(n, 1) = cle1
        CollecN.Add n, cle1 'mémorise la ligne
    End If
    cle2 = cle1 & Chr(1) & tablo(i, 2)
    On Error Resume Next
    Collec2.Add cle2, cle2
    If Err = 0 Then
        lig = CollecN(cle1)
        resu(lig, 2) = resu(lig, 2) + 1
    End If
Next i
'---restitution---
With [E2] 'cellule à adapter
    If n Then .Resize(n, 2) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub
A+
 

Pièces jointes

  • bdl(1).xlsm
    27.9 KB · Affichages: 5