Regroupement de donnée

bonjour

je vous souhaite une bonne année a vous tous

j'ai fait un fichier

feuille 1 fichier d'origine

la deuxieme feuille Resultat Regroupés

dasn ma deuxieme feuille mon programme ne focntionne pas il ne additionnne pas les colonne 7 et 8

je devrait avoir en 7 6526

en colonne 8 5300

Pouvez vous m'aider

Sub RassemblerParNumeroArticle()

    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    ' Utilisez la feuille de calcul active ou spécifiez la feuille ici
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacez "Feuil1" par le nom de votre feuille de données

    ' Trouver la dernière ligne de données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Créer une nouvelle feuille pour afficher les résultats
    Set newWs = ThisWorkbook.Sheets.Add
    newWs.Name = "Résultats Regroupés" ' Nom de la nouvelle feuille

    ' Ajouter les en-têtes sur la nouvelle feuille
    newWs.Cells(1, 1).Value = "Largeur Max"
    newWs.Cells(1, 2).Value = "Référence du Bulk"
    newWs.Cells(1, 3).Value = "Numéro d'Article"
    newWs.Cells(1, 4).Value = "Largeur du Rouleau"
    newWs.Cells(1, 5).Value = "Mandrins Utilisés"
    newWs.Cells(1, 6).Value = "Longueur du Rouleau"
    newWs.Cells(1, 7).Value = "Quantité en m²"
    newWs.Cells(1, 8).Value = "Mettrage Demandé"

    ' Parcours de toutes les lignes pour récupérer et regrouper les informations
    For i = 2 To lastRow ' On suppose que les en-têtes sont en ligne 1
        Dim articleNum As String
        articleNum = ws.Cells(i, 3).Value ' Colonne 3 : Numéro d'article

        ' Si l'article existe déjà dans le dictionnaire, on met à jour les valeurs
        If dict.Exists(articleNum) Then
            ' Ajouter les m² et metrage demandé (colonne 7 et 8) à chaque ligne du même article
            dict(articleNum)(5) = dict(articleNum)(5) + ws.Cells(i, 7).Value ' Additionner m² (colonne 7)
            dict(articleNum)(6) = dict(articleNum)(6) + ws.Cells(i, 8).Value ' Additionner metrage demandé (colonne 8)
        Else
            ' Si l'article n'existe pas dans le dictionnaire, on l'ajoute avec les données
            dict.Add articleNum, Array(ws.Cells(i, 1).Value, ws.Cells(i, 2).Value, ws.Cells(i, 4).Value, _
                                       ws.Cells(i, 5).Value, ws.Cells(i, 6).Value, ws.Cells(i, 7).Value, _
                                       ws.Cells(i, 8).Value)
        End If
    Next i

    ' Réécrire les résultats regroupés dans la nouvelle feuille
    Dim newRow As Long
    newRow = 2 ' Réécrire à partir de la ligne 2
    For Each Key In dict.Keys
        ' Remplir les données regroupées pour chaque numéro d'article
        newWs.Cells(newRow, 1).Value = dict(Key)(0) ' Largeur Max
        newWs.Cells(newRow, 2).Value = dict(Key)(1) ' Référence du Bulk
        newWs.Cells(newRow, 3).Value = Key ' Numéro d'article
        newWs.Cells(newRow, 4).Value = dict(Key)(2) ' Largeur du Rouleau
        newWs.Cells(newRow, 5).Value = dict(Key)(3) ' Mandrins Utilisés
        newWs.Cells(newRow, 6).Value = dict(Key)(4) ' Longueur du Rouleau
        newWs.Cells(newRow, 7).Value = dict(Key)(5) ' Total m² (additionné)
        newWs.Cells(newRow, 8).Value = dict(Key)(6) ' Total Metrage Demandé (additionné)

        newRow = newRow + 1
    Next Key

    MsgBox "Rassemblement des données terminé dans une nouvelle feuille !", vbInformation

End Sub

Bonjour,

Ton fichier aurait été le bien venu
A+

Bonsoir olivcoco, Jacky

C'est cette syntaxe qu'il faut utiliser, je l'ai fait avec une variable tableau.

a(i, 3) est la clé

la variable tableau w est l'item regroupant les 8 éléments dont les 2 derniers sont à additionner.

For i = 2 To UBound(a, 1)
    If Not dico.exists(a(i, 3)) Then
        ReDim w(1 To 8)
        w(1) = a(i, 1): w(2) = a(i, 2)
        w(3) = a(i, 3): w(4) = a(i, 4)
        w(5) = a(i, 5): w(6) = a(i, 6)
    Else
        w = dico(a(i, 3))    ' <-------
    End If
    w(7) = w(7) + a(i, 7)
    w(8) = w(8) + a(i, 8)
    dico(a(i, 3)) = w
Next

Rien ne t'empêche d'intégrer la clé dans l'item, ici elle est représentée par w(3)

Dans ton cas, pour la restitution, pas besoin de boucler sur les clés du dictionnaire, une seule ligne suffit :

' restitution
With newWs.Range("a2")
    .Resize(dico.Count, 8).Value = _
    Application.Transpose(Application.Transpose(dico.items))
End With

klin89

Bonjour

Merci à vous tous

Voici le scrip qui fonctionne

Sub RassemblerParNumeroArticle()

    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim dict As Object
    Dim key As Variant

    ' Création du dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")

    ' Utilisez la feuille de calcul active ou spécifiez la feuille ici
    Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplacez "Feuil1" par le nom de votre feuille de données

    ' Trouver la dernière ligne de données
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Vérification pour s'assurer qu'il y a des données
    If lastRow < 2 Then
        MsgBox "Aucune donnée à traiter.", vbExclamation
        Exit Sub
    End If

    ' Créer une nouvelle feuille pour afficher les résultats
    On Error Resume Next
    Set newWs = ThisWorkbook.Sheets("Résultats Regroupés")
    If newWs Is Nothing Then
        Set newWs = ThisWorkbook.Sheets.Add
        newWs.Name = "Résultats Regroupés"
    Else
        newWs.Cells.Clear ' Efface les anciennes données si la feuille existe déjà
    End If
    On Error GoTo 0

    ' Ajouter les en-têtes sur la nouvelle feuille
    newWs.Cells(1, 1).Value = "Largeur Max"
    newWs.Cells(1, 2).Value = "Référence du Bulk"
    newWs.Cells(1, 3).Value = "Numéro d'Article"
    newWs.Cells(1, 4).Value = "Largeur du Rouleau"
    newWs.Cells(1, 5).Value = "Mandrins Utilisés"
    newWs.Cells(1, 6).Value = "Longueur du Rouleau"
    newWs.Cells(1, 7).Value = "Quantité en m²"
    newWs.Cells(1, 8).Value = "Mettrage Demandé"
    newWs.Cells(1, 9).Value = "Date Demandée" ' Ajout de la colonne Date Demandée

    ' Parcours de toutes les lignes pour récupérer et regrouper les informations
    For i = 2 To lastRow
        Dim articleNum As String
        articleNum = ws.Cells(i, 15).Value ' Colonne 15 : Numéro d'article

        ' Récupérer les valeurs numériques (ou 0 par défaut si la cellule est vide ou invalide)
        Dim largeurMax As Double, refBulk As String, largeurRouleau As Double
        Dim mandrins As String, longueurRouleau As Double, quantiteM2 As Double, metrageDemande As Double
        Dim dateDemande As Variant ' Nouvelle variable pour la date

        largeurMax = Val(ws.Cells(i, 1).Value) ' Colonne 1 : Largeur Max
        refBulk = ws.Cells(i, 2).Value ' Colonne 2 : Référence Bulk
        largeurRouleau = Val(ws.Cells(i, 20).Value) ' Colonne 20 : Largeur du Rouleau
        mandrins = ws.Cells(i, 21).Value ' Colonne 21 : Mandrins Utilisés
        longueurRouleau = Val(ws.Cells(i, 22).Value) ' Colonne 22 : Longueur du Rouleau
        quantiteM2 = Val(ws.Cells(i, 24).Value) ' Colonne 24 : Quantité en m²
        metrageDemande = Val(ws.Cells(i, 25).Value) ' Colonne 25 : Mettrage Demandé

        ' Vérifier si la colonne 27 (Date Prioritaire) contient une date
        If IsDate(ws.Cells(i, 27).Value) Then
            dateDemande = ws.Cells(i, 27).Value ' Récupérer la date de la colonne 27
        Else
            dateDemande = "" ' Sinon, laisser vide
        End If

        ' Si l'article existe déjà dans le dictionnaire, on met à jour les valeurs
        If dict.Exists(articleNum) Then
            dict(articleNum)("quantite_m2") = dict(articleNum)("quantite_m2") + quantiteM2 ' Additionner m²
            dict(articleNum)("metrage_demande") = dict(articleNum)("metrage_demande") + metrageDemande ' Additionner métrage demandé
        Else
            ' Ajouter un nouvel élément au dictionnaire pour l'article
            Dim articleData As Object
            Set articleData = CreateObject("Scripting.Dictionary")
            articleData.Add "largeur_max", largeurMax
            articleData.Add "ref_bulk", refBulk
            articleData.Add "largeur_rouleau", largeurRouleau
            articleData.Add "mandrins", mandrins
            articleData.Add "longueur_rouleau", longueurRouleau
            articleData.Add "quantite_m2", quantiteM2
            articleData.Add "metrage_demande", metrageDemande
            articleData.Add "date_demande", dateDemande ' Ajouter la date demandée

            dict.Add articleNum, articleData
        End If
    Next i

    ' Réécrire les résultats regroupés dans la nouvelle feuille
    Dim newRow As Long
    newRow = 2 ' Réécrire à partir de la ligne 2
    For Each key In dict.Keys
        newWs.Cells(newRow, 1).Value = dict(key)("largeur_max") ' Largeur Max
        newWs.Cells(newRow, 2).Value = dict(key)("ref_bulk") ' Référence du Bulk
        newWs.Cells(newRow, 3).Value = key ' Numéro d'article
        newWs.Cells(newRow, 4).Value = dict(key)("largeur_rouleau") ' Largeur du Rouleau
        newWs.Cells(newRow, 5).Value = dict(key)("mandrins") ' Mandrins Utilisés
        newWs.Cells(newRow, 6).Value = dict(key)("longueur_rouleau") ' Longueur du Rouleau
        newWs.Cells(newRow, 7).Value = dict(key)("quantite_m2") ' Total m²
        newWs.Cells(newRow, 8).Value = dict(key)("metrage_demande") ' Total Metrage Demandé

        ' Ajouter la date demandée (colonne 9)
        If dict(key)("date_demande") <> "" Then
            newWs.Cells(newRow, 9).Value = dict(key)("date_demande") ' Mettre la date dans la colonne 9 si elle existe
        End If

        newRow = newRow + 1
    Next key

    ' Trier les données
    With newWs.Sort
        .SortFields.Clear
        ' Trier d'abord par Mandrins Utilisés (colonne 5)
        .SortFields.Add key:=newWs.Range("E2:E" & newRow - 1), Order:=xlAscending
        ' Puis par Longueur du Rouleau (colonne 6)
        .SortFields.Add key:=newWs.Range("F2:F" & newRow - 1), Order:=xlAscending
        ' Enfin par Largeur du Rouleau (colonne 4)
        .SortFields.Add key:=newWs.Range("D2:D" & newRow - 1), Order:=xlAscending
        ' Appliquer le tri
        .SetRange newWs.Range("A1:I" & newRow - 1) ' Inclure la colonne 9 (Date Demandée) dans le tri
        .Header = xlYes
        .Apply
    End With

    MsgBox "Rassemblement des données terminé et triées !", vbInformation

End Sub

Bonjour,

Si vous pouvez joindre un fichier d'exemple, c'est un sujet vraiment adapté à PowerQuery.

Bonjour
Voici le fichier ci joint

ReBonjour,

Ci-joint une proposition PowerQuery. J'ai formatté en tant que tableau structuré vos données dans Feuil1.

Si vous n'avez jamais utilisé powerquery :

Pour modifier : dans la source (feuil1) vous pouvez ajouter/supprimer des lignes dans le tableau. Ce qui compte ce sont les en-tete et son nom.

Ensuite dans la feuille QueryRegroupés, en cliquant dans le tableau vous aurez peut etre un panneau qui s'ouvre à droite "Connexions".

Il suffit de cliquer sur cette petite icône pour rafraichir la requête (équivalent de relancer votre macro).

Sinon, dans l'onglet données > Connexions > rafraichir tout.

Ci-joint votre fichier.