macro pour somme automatique selon critères

[slide2flow]

Bonsoir a tous,

Tout d'abord merci à ceux qui auront la courtoisie de lire mon message.

Est-il possible de creer une macro qui puisse résoudre le pb. suivant..

Soit en colonne A des dates (D1 à Dn) qui se succèdent. Soit en B, des valeurs de variables associées à la date D1-...Dn. Il y a à chaque fois un nombre différent de valeurs que l'on ne connait pas à l'avance. J'ai besoin de calculer la somme des valeurs de la variable pour chaque date D1-...Dn (à placer en collone C). Il faut donc balayer la colonne A pour identifier le nombre de lignes avec la même date, puis faire la somme des valeurs correspondantes aux lignes sélectionnées, et placer cette valeur en colonne C.

Je joins un fichier d'exemple à titre d'illustration, avec un exemple du resultat a obtenir avec seulement 5 dates différentes. En réalité j'ai 4000 dates différentes avec u fichier de 23000 lignes. Et j'aurai plusieurs fichiers à traiter par la suite. Je travaille sous exel windows 2000 ou XP.

Merci pour votre aide
Jean-Philippe [file name=slide2flow.zip size=2418]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/slide2flow.zip[/file]

 

[myDearFriend!]

Bonsoir Jean-Philippe,

Ci-joint peut-être une réponse à ta demande...

J'ai utilisé le code suivant :

Sub Traitement()
Dim TabTemp As Variant
Dim Cumul As Double
Dim D As Date
Dim L As Long
      With Sheets('Feuil1')
            'Charge les données dans un tableau variant temporaire
            L = .Range('A65536').End(xlUp).Row
            TabTemp = .Range(.Cells(1, 1), .Cells(L, 3)).Value
            'La première date est la date de référence
            D = TabTemp(1, 1)
            'Pour chaque ligne
            For L = 1 To UBound(TabTemp, 1)
                  'Compare la date avec la date de référence
                  If TabTemp(L, 1) <> D Then
                        'Si nouvelle date alors MAJ du cumul dans la ligne précédente
                        .Cells(L - 1, 3) = Cumul
                        'Redéfinit la date de référence et le cumul
                        D = TabTemp(L, 1)
                        Cumul = TabTemp(L, 2)
                  Else
                        'Cumule de la colonne B
                        Cumul = Cumul + TabTemp(L, 2)
                  End If
            Next L
            'MAJ du dernier cumul
            .Cells(L - 1, 3) = Cumul
      End With
End Sub

Cordialement, [file name=mDF_slide2flow.zip size=10530]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mDF_slide2flow.zip[/file]

 

[slide2flow]

Bonjour mdf,
Franchement nickel, ca marche sans problème. J'ai testé sur plusieurs gros fichiers et contrôlé pour quelques sommes au hasard, c'est parfait.
Si tu as encore quelques petites minutes à consacrer à ce problème, crois tu que l'on pourrait compléter le script de telle manière à:

- Prendre les résultats des sommes associées à chaque date (colonnes A et C).
- Coller ces sommes sur la même feuille en colonnes F et G (A en F, C en G)
- intercaler automatiquement les dates manquantes (en colonne A) et y associer toujours une valeur de zéro (colonne G).
Je joins à nouveau un exemple à titre d'illustration.
Bien sur à nouveau les fichiers comportent un nombre importan de lignes.
Merci d'avance
Bien cordialement
Jean-Philippe [file name=slide2flow2.zip size=6102]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/slide2flow2.zip[/file]

 

[myDearFriend!]

Bonsoir Jean-Philippe,

Ci-joint ton fichier modifié en conséquence...

Sub Traitement()
Dim TabTemp As Variant, TabResult() As Variant
Dim Cumul As Double
Dim D As Date
Dim L As Long, R As Long
      With Sheets('Feuil1')
            'Charge les données dans un tableau variant temporaire
            L = .Range('A65536').End(xlUp).Row
            TabTemp = .Range(.Cells(1, 1), .Cells(L, 3)).Value
            'La première date est la date de référence
            D = TabTemp(1, 1)
            'Initialisation du tableau des résultats
            ReDim TabResult(1 To 2, 1 To 1)
            'Pour chaque ligne
            For L = 1 To UBound(TabTemp, 1)
                  'Compare la date avec la date de référence
                  If TabTemp(L, 1) <> D Then
                        'Si nouvelle date alors MAJ du cumul dans la ligne précédente
                        .Cells(L - 1, 3) = Cumul
                        'Stockage des résultats
                        TabResult(1, UBound(TabResult, 2)) = D
                        TabResult(2, UBound(TabResult, 2)) = Cumul
                        ReDim Preserve TabResult(1 To 2, 1 To UBound(TabResult, 2) + 1)
                              'pour dates inexistantes
                              For R = 1 To TabTemp(L, 1) - D - 1
                                    TabResult(1, UBound(TabResult, 2)) = D + R
                                    TabResult(2, UBound(TabResult, 2)) = 0
                                    ReDim Preserve TabResult(1 To 2, 1 To UBound(TabResult, 2) + 1)
                              Next R
                        'Redéfinition de la nouvelle date de référence et du cumul
                        D = TabTemp(L, 1)
                        Cumul = TabTemp(L, 2)
                  Else
                        'Cumule de la colonne B
                        Cumul = Cumul + TabTemp(L, 2)
                  End If
            Next L
            'MAJ du dernier cumul
            .Cells(L - 1, 3) = Cumul
            'Stockage du dernier cumul
            TabResult(1, UBound(TabResult, 2)) = D
            TabResult(2, UBound(TabResult, 2)) = Cumul
            'Affichage des résultats
            .Range(.Cells(1, 6), .Cells(UBound(TabResult, 2), 7)).Value = _
                  Application.WorksheetFunction.Transpose(TabResult)
      End With
End Sub

Cordialement, [file name=mDF_slide2flow2.zip size=12477]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/mDF_slide2flow2.zip[/file]

 

[slide2flow]

Bonjour didier,
Je n'ai eu accès à ton fichier que aujourd'hui. Parfait, exactement ce que j'espérais.
Un grand merci
Cordialement
Jean-Philippe

 

[aziz]

Bonjour,
Merci j'ai eu le meme souci.
slts,
Aziz