Microsoft 365 Macro Somme.Si.Ens

Bonjour YoussefCha,
En PJ un essai, j'ai repris la même structure que vous, en essayant d'accélérer un peu avec :
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.

sylvanu à dit:

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

VB:

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.

Cliquez pour agrandir...

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.

Bonsoir,
1- Pour rajouter un client il suffit de modifier cette ligne :
Le 12 c'est 2*6 clients
Si vous rajoutez un client il suffit alors de faire :
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 :
En particulier pour Montant qui serait en colonne E au lieu de D, il suffit alors de faire :

Et pour la vitesse, c'est supportable ainsi ?

sylvanu à dit:

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

VB:

For Colonne = 2 To 12 Step 2

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

Code:

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 :

Code:

    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 :

Code:

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

Et pour la vitesse, c'est supportable ainsi ?

Cliquez pour agrandir...

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

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.

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

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

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

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