Problème de macro / Addition

Bonjour à tous !

Dans le cadre d'un projet j'ai besoin de trier des produits (qui sont des panneaux définis par longueur, largeur, épaisseur). Jusqu'ici pas de problème. Ensuite, lorsque les produits sont de mêmes dimensions, je dois additionner leur quantité à fabriquer pour obtenir un sous total. Le problème est qu'il y a plus de 13000 références c'est pourquoi j'ai besoin d'une macro.

J'ai tenté quelque chose avec les quelques connaissances que j'ai mais cela ne fonctionne pas, ou plutôt mal, puisque le programme ne fait que recopier les quantités sans les sommer lorsque les panneaux sont de mêmes dimensions.

J'ai crée un fichier basé sur le même principe pour faire mes essais (cf pièce jointe)

Le code est le suivant :

Sub Tri_Par_Dimensions_Similaires()

    'Déclaration des variables
Dim i As Integer        'Numéro de ligne
Dim CTA As Integer      'Longueur
Dim CTB As Integer         'Largeur
Dim CTC As Integer      'Épaisseur
Dim Conso_15j As Integer        'Quantité

    'Déclaration des variables de numéro de colonne
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim q As Integer
Dim r As Integer

    'Initialisation
i = 2        'Numéro de ligne
a = 1       'Numéro colonne CTA
b = 2       'Numéro colonne CTB
c = 3       'Numéro colonne CTC
q = 4       'Numéro colonne Quantité
r = 5        'Numéro colonne Résultat

Do Until i = 16      'Répétition de la macro pour chaque ligne jusqu'a la fin du tableau

        CTA = Cells(i, a).Value     'Récupération des données de la ligne i
        CTB = Cells(i, b).Value
        CTC = Cells(i, c).Value
        Conso_15j = Cells(i, q).Value

        i = i + 1   'Passage à la ligne suivante

        If Cells(i, a).Value = CTC And Cells(i, b).Value = CTB And Cells(i, a).Value = CTA Then     'Comparaison
                Conso_15j = Conso_15j + Cells(i, q).Value     'Somme des qtés si même dimensions
        Else: Cells(i - 1, r) = Conso_15j       'Écriture de la qté totale sur la ligne du dernier produit pris en compte
        End If

Loop
End Sub
5test.xlsm (47.77 Ko)

Bonjour,

10test.xlsm (16.94 Ko)

A+

Merci beaucoup !

Rechercher des sujets similaires à "probleme macro addition"