Microsoft 365 Macro Somme.Si.Ens

[youssefcha]

Bonjour à tous,

J’ai un fichier Excel qui regroupe les données de plusieurs clients sur de longues périodes (onglet Doonées). Je veux effectuer des calculs (onglet Calc) sous la forme de Somme.Si.Ens en fonction des critères de Date, Nom du Client et autres critères (cf formule proposé cellule L2). Mais démultiplier la formule Somme.Si.Ens alourdit le fichier considérablement.

J’ai opté du coup pour une macro qui devrait faire le calcul pour l’ensemble des clients existants en commençant à chaque fois par la date de la première opération faite par chaque client.

J’aimerai votre aide pour compléter cette macro pour qu’elle tourne pour

• tous les clients renseignés en colonnes B, D, F, H…
• toutes les dates renseignées en lignes jusqu’à la dernière date qui serait celle d’aujourd’hui (et si possible, me proposer une formule ou un bout de code qui propage les dates jusqu’à aujourd’hui en partant de la date de la première opération)
• et si possible pour qu’elle affiche les résultats rapidement. Ce que j’ai fait aujourd’hui prend beaucoup de temps, sachant que le fichier de bases fait plusieurs milliers de lignes (toute alternative de syntaxe du code est la bienvenue)

Je joins un fichier pour illustrer mes propos. A ce stade, la macro tourne pour les colonnes B, D et F et pour les trente premières lignes.

Merci par avance de votre aide.

 

[sylvanu]

Bonjour YoussefCha,
En PJ un essai, j'ai repris la même structure que vous, en essayant d'accélérer un peu avec :

Sub Test2()
    Application.ScreenUpdating = False                                  'Ecran figé
    Application.Calculation = xlCalculationManual                       'Calcul manuel
    Dim Colonne%, NbLignes%, Taille%
    Dim Crit1 As Range, Crit2 As Range, Crit3 As Range, Somme As Range
    'Affectation la plage de cellules
    With Sheets("Données")
        NbLignes = .Cells(65000, 1).End(xlUp).Row                       'Nombre de lignes
        Set Crit1 = .Range("A2:A" & NbLignes)                           'Critère1
        Set Crit2 = .Range("B2:B" & NbLignes)                           'Client
        Set Crit3 = .Range("C2:C" & NbLignes)                           'Date
        Set Somme = .Range("D2:D" & NbLignes)                           'Montant
    End With
    'Calcul par client
    For Colonne = 2 To 12 Step 2                                        'Pour chaque client
        Taille = Cells(65000, Colonne - 1).End(xlUp).Row                'Nombre de lignes
        Range(Cells(2, Colonne), Cells(Taille, Colonne)).ClearContents  'Effacement données présentes
        Calcul Taille, Colonne, NbLignes, Crit1, Crit2, Crit3, Somme    'Remplissage des données
    Next
    'Vide affectation
    Set Crit1 = Nothing: Set Crit2 = Nothing: Set Crit3 = Nothing: Set Somme = Nothing
    Application.Calculation = xlCalculationAutomatic    'Retour en calcul automatic
End Sub
Sub Calcul(Taille, Colonne, NbLignes, Crit1 As Range, Crit2 As Range, Crit3 As Range, Somme As Range)
    For L = 2 To Taille 'Pour toutes les lignes
        Cells(L, Colonne) = Application.SumIfs(Somme, Crit1, Cells(1, 1).Value, Crit2, Cells(1, Colonne).Value, Crit3, Cells(L, Colonne - 1).Value)
    Next L
End Sub

En espérant que la vitesse vous suffise.
En passant par des arrays VBA je ne suis pas sur que cela soit plus rapide pour calculer les Somme.si.ens.
NB: Ne disposant que de XL2007 la fonction Min.Si est inconnue, donc j'ai fait un copier coller valeurs pour les dates. A vous de ré adapter sur votre fichier.

 

[youssefcha]

Bonjour YoussefCha,
En PJ un essai, j'ai repris la même structure que vous, en essayant d'accélérer un peu avec :

Sub Test2()
    Application.ScreenUpdating = False                                  'Ecran figé
    Application.Calculation = xlCalculationManual                       'Calcul manuel
    Dim Colonne%, NbLignes%, Taille%
    Dim Crit1 As Range, Crit2 As Range, Crit3 As Range, Somme As Range
    'Affectation la plage de cellules
    With Sheets("Données")
        NbLignes = .Cells(65000, 1).End(xlUp).Row                       'Nombre de lignes
        Set Crit1 = .Range("A2:A" & NbLignes)                           'Critère1
        Set Crit2 = .Range("B2:B" & NbLignes)                           'Client
        Set Crit3 = .Range("C2:C" & NbLignes)                           'Date
        Set Somme = .Range("D2:D" & NbLignes)                           'Montant
    End With
    'Calcul par client
    For Colonne = 2 To 12 Step 2                                        'Pour chaque client
        Taille = Cells(65000, Colonne - 1).End(xlUp).Row                'Nombre de lignes
        Range(Cells(2, Colonne), Cells(Taille, Colonne)).ClearContents  'Effacement données présentes
        Calcul Taille, Colonne, NbLignes, Crit1, Crit2, Crit3, Somme    'Remplissage des données
    Next
    'Vide affectation
    Set Crit1 = Nothing: Set Crit2 = Nothing: Set Crit3 = Nothing: Set Somme = Nothing
    Application.Calculation = xlCalculationAutomatic    'Retour en calcul automatic
End Sub
Sub Calcul(Taille, Colonne, NbLignes, Crit1 As Range, Crit2 As Range, Crit3 As Range, Somme As Range)
    For L = 2 To Taille 'Pour toutes les lignes
        Cells(L, Colonne) = Application.SumIfs(Somme, Crit1, Cells(1, 1).Value, Crit2, Cells(1, Colonne).Value, Crit3, Cells(L, Colonne - 1).Value)
    Next L
End Sub

En espérant que la vitesse vous suffise.
En passant par des arrays VBA je ne suis pas sur que cela soit plus rapide pour calculer les Somme.si.ens.
NB: Ne disposant que de XL2007 la fonction Min.Si est inconnue, donc j'ai fait un copier coller valeurs pour les dates. A vous de ré adapter sur votre fichier.

Merci beaucoup pour votre effort. J'essaie maintenant de rajouter des colonnes avec de nouveaux clients, mais ça ne semble pas fonctionner. Comment faire pour que la macro continue à donner des résultats à chaque fois qu'on rajoute un nouveau client en colonne ?

Autre tric, je devrais rajouter une colonne "intermédiaire" pour chaque client, qui fait le cumul journalier, (une colonne avant les dates du client suivant). Est ce que cela ne devrait pas changer la syntaxe du code actuel?
Merci beaucoup.

 

[sylvanu]

Bonsoir,
1- Pour rajouter un client il suffit de modifier cette ligne :

For Colonne = 2 To 12 Step 2

Le 12 c'est 2*6 clients
Si vous rajoutez un client il suffit alors de faire :

For Colonne = 2 To 14 Step 2

en supposant que client 7 soit en colonnes M et N.
2- Si bien sur cela va changer le code pour la définition des plages :

    With Sheets("Données")
        NbLignes = .Cells(65000, 1).End(xlUp).Row                       'Nombre de lignes
        Set Crit1 = .Range("A2:A" & NbLignes)                           'Critère1
        Set Crit2 = .Range("B2:B" & NbLignes)                           'Client
        Set Crit3 = .Range("C2:C" & NbLignes)                           'Date
        Set Somme = .Range("D2:D" & NbLignes)                           'Montant
    End With

En particulier pour Montant qui serait en colonne E au lieu de D, il suffit alors de faire :

 Set Somme = .Range("E2:E" & NbLignes)                           'Montant (modifié)

Et pour la vitesse, c'est supportable ainsi ?

 

[youssefcha]

Bonsoir,
1- Pour rajouter un client il suffit de modifier cette ligne :

For Colonne = 2 To 12 Step 2

Le 12 c'est 2*6 clients
Si vous rajoutez un client il suffit alors de faire :

For Colonne = 2 To 14 Step 2

en supposant que client 7 soit en colonnes M et N.
2- Si bien sur cela va changer le code pour la définition des plages :

    With Sheets("Données")
        NbLignes = .Cells(65000, 1).End(xlUp).Row                       'Nombre de lignes
        Set Crit1 = .Range("A2:A" & NbLignes)                           'Critère1
        Set Crit2 = .Range("B2:B" & NbLignes)                           'Client
        Set Crit3 = .Range("C2:C" & NbLignes)                           'Date
        Set Somme = .Range("D2:D" & NbLignes)                           'Montant
    End With

En particulier pour Montant qui serait en colonne E au lieu de D, il suffit alors de faire :

 Set Somme = .Range("E2:E" & NbLignes)                           'Montant (modifié)

Et pour la vitesse, c'est supportable ainsi ?

Bonsoir,

ton code marche super bien. Ce qui ralentit je crois c'est la démultiplication de la fonction Sequence (date) qui va chercher la date d'entrée de chaque client.

Merci

 

[youssefcha]

Bonjour Sylvanu,

Je me permets de te solliciter encore une fois pour développer ma macro.

J'explore la possibilité maintenant d'avoir une formule du type somme.si.ens qui se cumule au fil des dates pour chaque client.

Mon idée est la suivante :

à chaque fois qu'une ligne de la colonne A (ou C ou E...) est renseignée par une date, la macro va dupliquer la formule qui est dans B3 (ou D3 ou F3) jusqu'à la dernière ligne de date renseignée.

ligne 2 =SOMME.SI.ENS
ligne 3 = SOMME.SI.ENS + ligne2

La formule devra s'étendre à partir de la ligne 3 sur les colonnes B, D, F tant que la colonne date A, C, E etc sont renseignées

Sub Test()
Dim cel As Range
With Worksheets("Feuil1") 'S'daptera au nom de la feuille
Set cel = .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 3)
.Range("E2", cel).FormulaR1C1 = .Range("E2").FormulaR1C1
End With
End Sub

Mes questions sont les suivantes :

- Comment je définis ici ma formule ?
- A quel moment je dois introduire un bout de code du genre : For Colonne = 2 To 20 Step 2 pour faire le travail sur les colonnes B, D,F, H etc..?

Merci infiniment.

 

[chris]

Bonjour à tous

Une solution PowerQuery, intégré à Excel, sans VBA

Si la source change ou si AFI (en jaune) remplacé par autre chose, Données, Actualiser tout

 

[sylvanu]

Bonjour YoussefCha, Chris,
L'autre approche en VBA (voir PJ) en modifiant un peu le code :

Sub Calcul(Taille, Colonne, NbLignes, Crit1 As Range, Crit2 As Range, Crit3 As Range, Somme As Range)
    Cells(2, Colonne) = Application.SumIfs(Somme, Crit1, Cells(1, 1).Value, Crit2, Cells(1, Colonne).Value, Crit3, Cells(2, Colonne - 1).Value)
    For L = 3 To Taille 'Pour toutes les lignes
        Cells(L, Colonne) = Cells(L - 1, Colonne) + Application.SumIfs(Somme, Crit1, Cells(1, 1).Value, Crit2, Cells(1, Colonne).Value, Crit3, Cells(L, Colonne - 1).Value)
    Next L
End Sub

 

[youssefcha]

Merci beaucoup pour vos réponses qui marchent bien. Ceci dit, je pense qu'une macro qui va copier-coller la formule jusqu'à la dernière ligne serait plus rapide qu'une macro qui fait directement le calcul. J'aimerai explorer la piste d'une macro qui va copier coller la formule Somme.si.ens(xxxxx)+cell précédente

 

[youssefcha]

Pour être plus précis, je souhaiterai mettre un code du genre :

Sub Copierformule()
Dim DL As Long
With ActiveSheet
DL = .Range("A" & Rows.Count).End(xlUp).Row
.Range("D2" & DL).Formula = .Range("D2").Formula
End With
End Sub

de sorte à copier la formule dans B2, D2, F2 dans les lignes suivantes, tant que les lignes A, C, E...sont non vides