Compter le nombre d'occurence en VBA

apt

XLDnaute Impliqué
Bonsoir à tous,

Pour compter le nombre d'occurrences (les premier 5 chiffres à partir de la gauche) dans une liste de numéros, j'ai utilisé un code VBA déposé sur XLD par ROBERT.

Mais voila, il n y'a rien de trouvé juste des zéros !

En PJ un exemple.

Merci d'avance.
 

Pièces jointes

  • CompteOccu (1).xls
    43 KB · Affichages: 196
  • CompteOccu (1).xls
    43 KB · Affichages: 196
  • CompteOccu (1).xls
    43 KB · Affichages: 210
Dernière édition:

jpb388

XLDnaute Accro
Re : Compter le nombre d'occurence en VBA

Bonjour
j'ai très légèrement modifié la macro de Robert
 

Pièces jointes

  • CompteOccu (1).xls
    50.5 KB · Affichages: 223
  • CompteOccu (1).xls
    50.5 KB · Affichages: 209
  • CompteOccu (1).xls
    50.5 KB · Affichages: 206

R@chid

XLDnaute Barbatruc
Re : Compter le nombre d'occurence en VBA

Bonjour Apt,
Bonjour jbp388,
et Salut Robert :eek:,
en E3 :
Code:
=SOMMEPROD(N(GAUCHE(B$2:B$32;5)*1=D3))
@ valider par Ctrl+Maj+Entree
@ tirer vers le bas
Amicalement

Edit : J'ai mal compris la question
 
Dernière édition:

apt

XLDnaute Impliqué
Re : Compter le nombre d'occurence en VBA

Bonjour jbp388, R@chid

Merci rachid pour la formule.

J'aimerais pour une deuxième étape, compter les occurrences selon un nom de groupe de code (Tableau de correspondance : L1:M8)

Explication :

Dans la première étape, on a eu ce tableau :


Code Nbr
55100 10
55101 10
55102 10
55103 10
55104 10
55105 3

Alors selon le tableau de correspondance :

Nom Code
CC 55100
CC 55101
BK 55102
SB 55103
SR 55104
SR 55105
SR 55106


J’aimerais avoir le résultat suivant :

Nom Nbr
CC 20
BK 10
SB 10
SR 13

Voir l'exemple en PJ.

Merci d'avance.
 

Pièces jointes

  • CompteOccu (3).xls
    57.5 KB · Affichages: 105
  • CompteOccu (3).xls
    57.5 KB · Affichages: 113
  • CompteOccu (3).xls
    57.5 KB · Affichages: 106

apt

XLDnaute Impliqué
Re : Compter le nombre d'occurence en VBA

Salut jpb388,

Merci pour le fichier.

Pour les noms, j'ai une liste de 45 noms.

N y'a-t-il pas un moyen pour éviter d'écrire 45 CASE dans le SELECT .. CASE ?

Code:
Select Case Range("L" & Lg1)
        Case "A"
            Range("J2") = Range("J2") + Range("D" & i)
        Case "B"
            Range("J3") = Range("J3") + Range("D" & i)
        Case "C"
            Range("J4") = Range("J4") + Range("D" & i)
        Case "D"
            Range("J5") = Range("J5") + Range("D" & i)
        Case "E"

        Case "F"

        Case "G"

        Case "H"

        Case "I"
        
        ... etc
        
End Select

Merci.
 

R@chid

XLDnaute Barbatruc
Re : Compter le nombre d'occurence en VBA

Bonjour @ tous,
Pour la 1ere question,
en D2 :
Code:
=SOMMEPROD(N(GAUCHE(A$2:A$54;5)=C2&""))
@ tirer vers le bas

pour la 2eme question,
en J2 :
Code:
=SOMME(SI(L$2:L$10=I2;NB.SI(C$2:C$10;M$2:M$10)*(D$2:D$10)))
@ valider par CTrl+Maj+Entree
@ tirer vers le bas

VoirPJ
Amicalement
 

Pièces jointes

  • CompteOccu (3).xls
    51.5 KB · Affichages: 77
  • CompteOccu (3).xls
    51.5 KB · Affichages: 86
  • CompteOccu (3).xls
    51.5 KB · Affichages: 94

apt

XLDnaute Impliqué
Re : Compter le nombre d'occurence en VBA

Bonsoir jpb388,

J'ai fais des essais, et j'ai remarqué que si une valeur de CODE dans la colonne I n'est pas trouvée dans la colonne M, alors le code tourne en boucle sans arrêt.
 

Pièces jointes

  • CompteOccu (4).xls
    81 KB · Affichages: 96

jpb388

XLDnaute Accro
Re : Compter le nombre d'occurence en VBA

Bonjour à tous
macro rectifié
ne prend pas en compte la ligne doit on afficher un messager
 

Pièces jointes

  • CompteOccu (3).xls
    61.5 KB · Affichages: 98
  • CompteOccu (3).xls
    61.5 KB · Affichages: 112
  • CompteOccu (3).xls
    61.5 KB · Affichages: 110

apt

XLDnaute Impliqué
Re : Compter le nombre d'occurence en VBA

Bonsoir jpb388,

Voila un code rectifié, et fonctionne bien sauf s'il y a des remarques à apporter.

Code:
Sub CompteNom()
    Dim i&
    Dim LgNom As Range, Trouvé As Range
    
    '-- S'il y a une ligne I2
    If [I2] <> "" Then
        Range("i2:J" & Range("i" & Rows.Count).End(xlUp).Row).ClearContents
    End If
    
    For i = 2 To Range("c" & Rows.Count).End(xlUp).Row
        Set LgNom = Range("m2:m" & Range("m" & Rows.Count).End(xlUp).Row) _
                    .Find(Range("c" & i))
        If Not LgNom Is Nothing Then
            Set Trouvé = Range("i2:i" & Range("i" & Rows.Count).End(xlUp).Row) _
                         .Find(Range("l" & LgNom.Row))
            If Not Trouvé Is Nothing Then
                Range("j" & Trouvé.Row) = Range("j" & Trouvé.Row) + Range("D" & i)
            Else
                Cells(Range("i" & Rows.Count).End(xlUp).Row, "i").Offset(1, 0) = Range("l" & LgNom.Row)
                Cells(Range("i" & Rows.Count).End(xlUp).Row, "i").Offset(0, 1) = Range("D" & i)
            End If
        Else
            MsgBox Range("c" & i) & " Pas trouvée dans la plage = " & _
                   Range("m2:m" & Range("m" & Rows.Count).End(xlUp).Row).Address
        End If
    Next
End Sub

:)
 

apt

XLDnaute Impliqué
Re : Compter le nombre d'occurence en VBA

Bonsoir jpb388,

Voila un code rectifié. Il fonctionne bien sauf s'il y a des modifications ou remarques à apporter.

Code:
Sub CompteNom()
    Dim i&
    Dim LgNom As Range, Trouvé As Range
    
    '-- S'il y a une ligne I2
    If [I2] <> "" Then
        Range("i2:J" & Range("i" & Rows.Count).End(xlUp).Row).ClearContents
    End If
    
    For i = 2 To Range("c" & Rows.Count).End(xlUp).Row
        Set LgNom = Range("m2:m" & Range("m" & Rows.Count).End(xlUp).Row) _
                    .Find(Range("c" & i))
        If Not LgNom Is Nothing Then
            Set Trouvé = Range("i2:i" & Range("i" & Rows.Count).End(xlUp).Row) _
                         .Find(Range("l" & LgNom.Row))
            If Not Trouvé Is Nothing Then
                Range("j" & Trouvé.Row) = Range("j" & Trouvé.Row) + Range("D" & i)
            Else
                Cells(Range("i" & Rows.Count).End(xlUp).Row, "i").Offset(1, 0) = Range("l" & LgNom.Row)
                Cells(Range("i" & Rows.Count).End(xlUp).Row, "i").Offset(0, 1) = Range("D" & i)
            End If
        Else
            MsgBox Range("c" & i) & " Pas trouvée dans la plage = " & _
                   Range("m2:m" & Range("m" & Rows.Count).End(xlUp).Row).Address
        End If
    Next
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Compter le nombre d'occurence en VBA

Bonsoir le fil, bonsoir le forum,

Apt, je souhaiterais, quand tu modifies un code et qu'il ne marche plus, tu ne me cites pas comme en étant l'auteur... J'ai bien reconnu mon code et les commentaires que je fais mais j'ai bien vu qu'en l'état il n'était plus adapté. Je ne pense pas que je l'aurais laissé comme ça...
Ci-dessous le code adapté et qui fonctionne :
Code:
Sub CompteOccu()
Dim dl As Long    'déclare la variable dl (Dernière Ligne)
Dim pl As Range    'déclare la variable pl (PLage)
Dim dico As Object    'déclare la variable dico (DICtiOnnaire)
Dim cel As Range    'déclare la variable cel (CELLule)
Dim temp As Variant    'déclare la variable temp (tableau TEMPoraire)
Dim cpt As Integer 'déclare la variable cpt (ComPTeur)

Set dico = CreateObject("Scripting.Dictionary")    'définit le dictionnaire dico
With Sheets("Feuil1")    'prend en compte l'onglet "Feuil1"
    .Cells(3, 4).CurrentRegion.ClearContents    'efface les anciennes données
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row    'définit la dernière ligne dl de la colonne B
    Set pl = .Range("B2:B" & dl)    'définit la plage pl
    For Each cel In pl    'boucle sur toutes les cellules cel de la plage pl
        dico(Left(cel, 5)) = ""   'alimente le dictionnaire
    Next cel    'prochaine cellule de la boucle
    temp = dico.keys    'récupère le dictionnaire sans doublons
    Call Tri(temp, LBound(temp), UBound(temp))    'lance la procédure de tri croissant du tableau temp
    For x = 0 To UBound(temp)    'boucle sur tous les éléments du tableau tri
        cpt = 0
        .Cells(x + 3, 4).Value = temp(x)     'place l'étiquette
        For Each cel In pl
            If Left(cel.Value, 5) = temp(x) Then cpt = cpt + 1
        Next cel
        .Cells(x + 3, 5).Value = cpt  'place le compteur
    Next x    'prochain élément de la boucle
End With    'fin de la prise en compte de l'onglet "BDD"
End Sub


Sub Tri(a As Variant, gauc As Integer, droi As Integer)    'tiré du site de Jacques BOISGONTIER [url=http://boisgontierjacques.free.fr/]Formation Excel VBA JB[/url]
Dim ref As Variant
Dim g As Integer, d As Integer
Dim tmp As Variant
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
        tmp = a(g): a(g) = a(d): a(d) = tmp
        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 fichier :
 

Pièces jointes

  • Apt_v02.xls
    50 KB · Affichages: 199

Discussions similaires

Réponses
7
Affichages
347

Statistiques des forums

Discussions
312 195
Messages
2 086 078
Membres
103 111
dernier inscrit
Eric68350