Additionner et conserver résultat dans variable

Résolu
Bonjour tous le monde!

J'aimerais savoir comment conserver le résultat d'une addition (qui est faite dans une boucle avec condition) dans une variable pour exporter le résultat dans un autre onglet.

J'en suis au code suivant mais j'obtiens le résultat 0 dans la nouvelle feuille.
En faite j'aimerais comparer 2 à 2 les cellules de la colonne 2 et tant quelles sont égales additionner les valeurs de la colonne 4. Puis copier le résultat dans la cellule d'une nvelle feuille. Ensuite passer à une nouvelle valeur de la colonne 2, refaire les additions et copier le résulat dans une autre cellule de la nvelle feuille.
Sub macro1()
Dim ligne As Integer
Dim Sum As Long
Dim feuille As Worksheet

Sum = 0
ligne = 2 'les données démarrent à partir de la seconde ligne

Range("B2").Select 'je trie les données
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("B2")

Do While Cells(ligne, 2).Value <> Null 'données à comparées en colonne 2
If Cells(ligne, 2).Value = Cells(ligne + 1, 2) Then

Sum = Sum + Cells(ligne, 4).Value
ligne = ligne + 1
End If
Loop

'je mets les résultats dans un autre onglet
Set feuille = Sheets.Add
feuille.Name = "selection" & a
Worksheets("selection" & a).Cells(1, 1).Value = Sum

End Sub


Dans un premier temps est-ce que c'est compliqué? Et est-ce que je pourrait avoir de indications sur les fonctions à utiliser ou des conseil pour aborder ce problème.

MERCI D'AVANCE POUR VOS REPONSES!!!

8 réponses

  1. Re,

    La sélection n'a rien à voir avec ce code !

    .Row
    c'est le numéro de la 1° ligne
    de
    .Columns("B").Cells 

    dans
    .Resize(.Rows.Count - 1).Offset(1)

    du tableau
    Worksheets("feuil1").Range("A1").CurrentRegion
    .

    C'est à dire, de 1° ligne de la plage de cellules qui va de la seconde à la dernière des lignes de la colonne "B" du tableau situé en A1 (dans ce cas .Row = 2)

    c.Row
    c'est le numéro de ligne de la cellule c, c'est à dire de chacune des cellules de la plage définie ci-dessus (i.e. varie de 2 à la dernière ligne).

    If c.Row > .Row Then Set d = d.Offset(1)
    décale la cellule de destination (d) d'une ligne vers le bas sauf quand c.Row = .Row (i.e sauf pour la ligne 2).
    J'aurais pu écrire
    If Not c.Row = .Row Then  Set d = d.Offset(1)

    1
    1. J'ai tout compris!!!:)
      0
  2. Bonjour,

    Pour moi, la zone de tri (par colonne B) est colonne B a D, pas seulement B sinon resultats faux.
    Nom de feuille "selection" & a, d'ou sort ce a ?????????????????????

    une facon de faire:

    Sub macro1()
        Dim ligne As Integer
        Dim Sum As Long
        Dim feuille As Worksheet
        Dim Flag_Ok As Boolean
     
        NL = 1
        Nb = 1
        Sum = 0
        ligne = 2 'les données démarrent à partir de la seconde ligne
        'feuille selection existe ??
        For x = 1 To Worksheets.Count
            If Worksheets(x).Name = "selection" & a Then
                Flag_Ok = True
                Exit For
            End If
        Next x
        'ajout feuille si existe pas
        If Not Flag_Ok Then
            Set feuille = Sheets.Add
            feuille.Name = "selection" & a      'le a sort de nulle part ?????????????????????
        End If
        With Worksheets("feuil1")
            .Range("B2:D" & .Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("B2")     'tri zone par Colonne B
            Do While .Cells(ligne, 2).Value <> "" 'données à comparées en colonne 2
                If .Cells(ligne, 2).Value = .Cells(ligne + 1, 2) Then
                    Sum = Sum + .Cells(ligne, 4).Value
                    Nb = Nb + 1
                Else
                    'je mets les résultats dans un autre onglet
                    If Nb > 1 Then      'x cellules colonnes 2 egales
                        ST = Sum + .Cells(ligne, 4)
                    Else        'une seule cellule
                        ST = .Cells(ligne, 4)
                    End If
                    Worksheets("selection" & a).Cells(NL, 1).Value = ST
                    NL = NL + 1     'incremente ligne feuille resultat
                    Sum = 0           'initialisation Somme
                End If
                ligne = ligne + 1       'incremente ligne feuille donnees
            Loop
        End With
    End Sub
    0
    1. Bonjour,

      Il ne faut pas utiliser de mot réservé au VBA pour nommer des variables !
      En l’occurrence Sum est un mot du langage, changes le nom de cette variable.

      Il est vivement conseillé de commencer chaque module par :
      Option Explicit
      (à mettre sur la 1° ligne avant Sub macro1)
      Cela t'aurais permis de constater le la variable "a" n'est pas déclarée (elle n'est également pas définie).

      Cordialement
      Patrice
      0
      1. Bonjour maroon,

        Tu n'as pas indenté correctement ton code VBA !

        Si tu l'avais fait, tu aurais pu te rendre compte plus facilement que
        ligne = ligne + 1 n'est exécuté que dans le bloc If ... End If !

        -------------------------------------------------------------------------------

        D'autre part, la plage du type Integer va de -32 768 à 32 767.

        Donc pour ta variable ligne, tu peux laisser comme c'est si tu es sûr
        que ni maintenant, ni plus tard, tu ne dépassera pas 32 767 lignes
        (sinon : plantage !).

        Si tu penses dépasser 32 767 lignes, choisis le type juste au-dessus :
        Dim ligne As Long   ' plage : va de -2 147 483 648 à 2 147 483 647 !

        Cela explique aussi que le type Long que tu as choisis pour Sum
        est valable si tu ne dois additionner que des nombres entiers ;
        sinon, il faut choisir un des types Single, Double ou Currency.

        -------------------------------------------------------------------------------

        Les variables numériques sont initialisées à 0 au moment de leur
        déclaration : Dim Sum As Long crée ta variable Sum en affectant
        la valeur 0 « dès le départ ». Donc ta ligne Sum = 0 est inutile !

        De plus, Sum est déjà un mot-clé de VBA ; je l'ai donc renommé
        Total.

        -------------------------------------------------------------------------------

        Le tri des données doit être fait sur les colonnes B à D, pour que
        les nombres de la colonne D gardent leur correspondance avec
        les nombres de la colonne B !

        -------------------------------------------------------------------------------

        Dans les 2 dernières lignes de ta Sub, tu utilises une variable « a »
        que tu n'as pas définie !

        -------------------------------------------------------------------------------

        Voici ton code VBA réécrit avec indentation et petits changements :

        
        Option Explicit
        
        
        Sub Essai()
        
          Dim Total As Long, ligne As Long
          Range("B2:D" & [B2].End(xlDown).Row).Sort [B2] ' tri des données
          ligne = 2 ' les données démarrent à partir de la seconde ligne
        
          Do While Not IsEmpty(Cells(ligne, 2)) ' données à comparer en colonne 2
            If Cells(ligne, 2) = Cells(ligne + 1, 2) Then Total = Total + Cells(ligne, 4)
            ligne = ligne + 1
          Loop
        
          ' je mets la somme sur une autre feuille
          Worksheets.Add , Worksheets(1): ActiveSheet.Name = "Sélection": [A1] = Total
        
        End Sub
        

        Cordialement.  😊
         
        0
        1. Merci beaucoup pour vos réponses!!!
          Je regarde tout ça et je fais un retour!
          0
          1. Rebonjour,

            Merci encore pour votre aide! f894009 ton code est vraiment proche de ce que je cherche! car il faut créer une ligne pour chaque nouveaux résultats! je l'ai modifié avec les remarques d'albkan.
            Pour le tri effectivement il y a un problème il faudrait qu'il soit étendu à tous le tableau mais j'utilise des tableaux qui ont des nombres de colonnes différents, seules les 4 premières colonnes sont constantes.
            je dois donc modifier
            Worksheets("feuil1")
                    .Range("B2:D" & .Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("B2")


            B2 deviens A2 mais j'arrive pas à remplacer le D! j'essaye d'utiliser la foncion .end(xltoright) mais ça beug et si je veux trier en fonction de la colonne B je dois bien laisser B2 dans la formule?
            Ensuite les résulats dans les différentes cellules ne correspondent pas donc j'essaye de modifier la boucle.

            Option Explicit
            
            Sub macro2()
            Dim ligne As Integer
                Dim total As Double
                Dim feuille As Worksheet
                Dim Flag_Ok As Boolean
             Dim NL As Integer 'moi
             Dim NB As Integer
             Dim x As Integer
              Dim ST As Double
             
             
                NL = 1
                NB = 1
                ligne = 2
                total = Worksheets("feuil1").Range("D" & ligne).Value 'les données démarrent à partir de la seconde ligne : PROBLEME 1
                
                'feuille selection existe ??
            
                For x = 1 To Worksheets.Count
                    If Worksheets(x).Name = "selection"  Then
                        Flag_Ok = True
                        Exit For
                    End If
                Next x
                'ajout feuille si existe pas
                If Not Flag_Ok Then
                    Set feuille = Sheets.Add
                    feuille.Name = "selection" 
                End If
                With Worksheets("feuil1")
                    .Range("B2:D" & .Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=.Range("B2")     'tri zone par Colonne B: PROBLEME 2
                    Do While .Cells(ligne, 2).Value <> "" 'données à comparées en colonne 2
                        If .Cells(ligne, 2).Value = .Cells(ligne + 1, 2) Then
                            total = total + .Cells(ligne + 1, 4).Value
                            NB = NB + 1
                        Else
                            'je mets les résultats dans un autre onglet
                            If NB > 1 Then      'x cellules colonnes 2 egales
                                ST = total + .Cells(ligne + 1, 4)
                            Else        'une seule cellule
                                ST = .Cells(ligne, 4)
                            End If
                            Worksheets("selection" ).Cells(NL, 1).Value = ST
                            NL = NL + 1     'incremente ligne feuille resultat
                            total = 0           'initialisation Somme: PROBLEME 3
                        End If
                        ligne = ligne + 1       'incremente ligne feuille donnees
                    Loop
                End With
            End Sub


            J'ai remplacé sum = 0 par
            total = Worksheets("feuil1").Range("D" & ligne).Value
            ça ne marche pas mais je l'ai fait car il faudrait que la cellule de départ pour l'opération de sommes (colonne D) corresponde au changement dans la colonne B.
            Par exemple si j'ai :

            A B C D
            1 1 2 1
            3 1 3 5
            4 0 3 1
            0 0 3 3

            alors je dois additionner 1 + 5 et copier 6 dans une cellule, puis 1 + 3 et copier 4 dans une autre cellule (car on passe de 1 à 0 dans B)

            Si vous avez encore de l'aide à me donner!! :) En tout cas merci beaucoup!
            0
            1. Bonjour,

              Etant donné quil n'y a pas de lignes vide tu peux trier avec :
              Worksheets("feuil1").Range("B2").CurrentRegion.Sort Key1:=.Range("B2")
              

              Cordialement
              Patrice
              0
              1. Ou si la tableau commence en A2 :
                Worksheets("feuil1").Range("A2").CurrentRegion.Sort Key1:=.Range("B2")
                
                0
              2. Essaies ce code :
                Option Explicit
                Sub macro2()
                Const n = "selection"
                Dim f As Worksheet
                Dim c As Range
                Dim d As Range  'destination
                Dim t As Double
                  
                  On Error Resume Next
                  Set f = Worksheets(n)
                  On Error GoTo 0
                  If f Is Nothing Then
                    Set f = Worksheets.Add
                    f.Name = n
                  End If
                  Set d = f.Cells(1, 1)
                  With Worksheets("feuil1").Range("A1").CurrentRegion
                    .Sort Key1:=.Cells(2, 2), header:=xlYes
                    With .Resize(.Rows.Count - 1).Offset(1)
                      For Each c In .Columns("B").Cells
                        If c.Value = c.Offset(-1).Value Then
                          t = t + c.Offset(0, 2).Value
                          d.Value = t
                        Else
                          t = c.Offset(0, 2).Value
                          If c.Row > .Row Then Set d = d.Offset(1)
                          d.Value = t
                        End If
                      Next c
                    End With
                  End With
                End Sub

                Cdlt
                Patrice
                0
              3. rebonjour!
                j'ai encore une question! j'arrive pas à comprendre cette ligne
                If c.Row > .Row Then Set d = d.Offset(1)


                c.Row>.Row ça correspond à quoi?
                dans offset(1) le 1 correspond à la ligne?
                0
              4. Je crois que c'est bon! Ca veut dire que si la ligne de la cellule c est supérieur à la ligne active alors déplacer "d" sur la ligne inférieure? Et en fait c'est la feuille "selection" qui est active? Si je ne me trompe pas alors comment la différence est faite entre les deux feuilles?!

                Merci d'avance!!
                0
            2. Merci pour ta réponse! ça fonctionne exactement!!
              Le code de f894009 effectue le calcul avec un décalage d'une ligne, et j'essaie de comprendre pourquoi.

              Merci beaucoup là je suis motivé pour continuer!:)
              0