comptage

[stoky]

Bonjour, à l'aide d'une formule ou d'in code VBA si nécessaire, je voudrais pourvoir litser toutes les occurences d'une colonne et compter additionné les nombres qui y sont associés. j'ai fiat un petit fichier car c'est plus parlant que mon texte. Merci d'avance.

 

[vgendron]

Re : comptage

Hello
en B22
=SOMMEPROD(($A$3:$A$17=A22)*$B$3:$B$17)
et tu tires vers le bas ;-)

 

[job75]

Re : comptage

Bonjour stoky, vgendron,

C'est un sujet maintes fois traité sur XLD, par formules ou par VBA.

Par VBA, le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim source As Range, dest As Range, t, d As Object, i&, a, b
Set source = [A2] 'à adapter
Set dest = [A22] 'à adapter
Set source = Intersect(Target, source.CurrentRegion, Me.UsedRange)
If source Is Nothing Then Exit Sub
t = source.CurrentRegion 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(t)
  d(t(i, 1)) = d(t(i, 1)) + t(i, 2)
Next
Application.ScreenUpdating = False
dest.Resize(Rows.Count - dest.Row + 1, 2).ClearContents 'RAZ
If d.Count Then
  '---transposition---
  a = d.keys: b = d.items
  ReDim t(UBound(a), 1)
  For i = 0 To UBound(a)
    t(i, 0) = a(i)
    t(i, 1) = b(i)
  Next
  '---restitution et tri alphabétique---
  dest.Resize(i, 2) = t
  dest.Resize(i, 2).Sort dest, xlAscending, Header:=xlNo
End If
End Sub

Fichier joint.

A+

 

[klin89]

Re : comptage

Bonjour job75, vgendron, stoky le forum

Pas vu la réponse de job75, c'est fait, je post :

Sub Compter()
Dim a, i As Long, n As Long
    Application.ScreenUpdating = False
    With Range("a2").CurrentRegion
        a = .Value
        ReDim Preserve a(1 To UBound(a, 1), 1 To 2)
        n = 1
        With CreateObject("Scripting.Dictionary")
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    n = n + 1
                    a(n, 1) = a(i, 1)
                    a(n, 2) = a(i, 2)
                    .Item(a(i, 1)) = n
                Else
                    a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) + a(i, 2)
                End If
            Next
        End With
        With .Offset(, .Columns.Count + 1)
            .CurrentRegion.Clear
            .Resize(n, 2).Value = a
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
            With .Rows(1)
                .Interior.ColorIndex = 41
                .Font.ColorIndex = 2
                .Font.Size = 11
                .Borders(xlInsideVertical).Weight = xlThin
                .BorderAround Weight:=xlThin
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[job75]

Re : comptage

Re, hello klin89,

La solution par formule dans le fichier joint.

J'ai mis aussi une MFC pour formater les 2 tableaux et masquer les #N/A.

A+

 

[job75]

Re : comptage

Bonjour stoky, le forum,

Fichier (2) en cas de cellules vides dans le tableau source.

Et en B22 une formule un peu plus simple avec SOMME.SI.

A+