[VBA] - Solution la plus rapide pour lister val. uniques + sommes

Bonsoir,

J'ai une liste de données en colonne A, dont plusieurs se répètent et en colonne B j'ai des effectifs.

Si je veux obtenir une liste avec chaque données en colonne A renseigné 1 fois et en colonne B la somme des effectifs pour chaque donnée. Comment dois-je m'y prendre ?

Je connais deux solutions :

• Lister chaque valeur unique (avec une collection par exemple) puis effectuer une recherche + somme pour chaque effectif trouvé.
• Classer les données dans l'odre alphabétique. Partir du bas de la plage et faire la somme de chaque effectif en remontant, puis supprimer ligne après ligne lors que la somme est faite (si données du dessus en col A est identique).

Je pourrais avoir à traiter 5000 lignes, c'est pourquoi j'essaie de trouver la solution la plus efficace. Vous avez une idée ?

Je joins un fichier Excel si besoin !

Merci de votre attention !

Bonne soirée

BOnjour

Un simple TCD fait cela en quelques clics...

Bonsoir,

En effet, on ne peut pas faire plus rapide.

Pour que ça puisse s'intégrer dans le reste du code, il faudrait que je face en sorte qu'il s'exécute avec VBA.

Je vais chercher de ce côté là. Je reviens si j'ai un code à proposer.

Bonne soirée !

Bonjour,

Commence par convertir les valeurs Nombre en valeurs numériques (Ruban, Données, Convertir, … , Standard).

Mets ensuite tes données sous forme de tableau et crée un TCD.

Cdlt.

Bonjour,

Merci de votre aide ! Je me suis basé sur ce qui était disponible sur le forum pour adapter un code et créer un TCD à partir de VBA.

Option Explicit
Dim dc As Worksheet, sy As Worksheet
Dim wsData As Worksheet, wsPT As Worksheet
Dim lCols As Long, lRow As Long, lRows As Long
Dim DataCollector As Range
Dim PTCache As PivotCache
Dim PT As PivotTable

Public Sub CreatePivotTable()

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    '----------------------------------------------------------------------
    Set dc = Worksheets("Données Collector")
    Set sy = Worksheets("VNEI (synthèse)")
    '----------------------------------------------------------------------
    On Error Resume Next
    sy.Delete
    On Error GoTo 0
    '----------------------------------------------------------------------
    With dc
        lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set DataCollector = .Cells(1, 1).Resize(lRows, lCols)
    End With
    '----------------------------------------------------------------------
    Set PTCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataCollector)
    '----------------------------------------------------------------------
    Set sy = ActiveWorkbook.Worksheets.Add(after:=Worksheets("Données Collector"))
    sy.Name = "VNEI (synthèse)"
    CreateWsEvenMacro
    '----------------------------------------------------------------------
    Set PT = PTCache.CreatePivotTable(sy.Cells(1, 1), "TCD_1")
    '----------------------------------------------------------------------
    With sy.PivotTables("TCD_1")
        With .PivotFields("effectif_precis"): .Orientation = xlColumnField: .Position = 1: End With
        sy.PivotTables("TCD_1").AddDataField ActiveSheet. _
        PivotTables("TCD_1").PivotFields("effectif_precis"), "Nombre de effectif_precis", xlCount
        With .PivotFields("nom_scientifique"): .Orientation = xlRowField: .Position = 1: End With
        With .PivotFields("effectif_precis"): .NumberFormat = "General": End With
    End With
    '----------------------------------------------------------------------
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    '----------------------------------------------------------------------
    Set PT = Nothing
    Set PTCache = Nothing
    Set DataCollector = Nothing
    Set wsData = Nothing
End Sub

Merci à Jean-Eric qui est à l'origine de 95% de ce code. Qui fonctionne bien à l'état actuel de l'avancement de mon projet.

Bonne journée !