Somme conditionnelle VBA

Version imprimable

17/06/2013, 11h52
fatifatirose

1 pièce(s) jointe(s)

Somme conditionnelle VBA

J'espère que vous allez bien.
Alors, j'ai besoin d'effectuer une somme conditionnelle sous excel. Je m'explique:
Je dispose d'un fichier d'origine où y'a quatre colonnes (Mois de l'échéance - Année de l'échéance - Montant des Impayés - Montant des échéances )
Pour chaque mois, je désire faire une sorte de suivi des impayés (ci-joint le tableau que je désire remplir).
Les mois vont de janvier 2012 à Mai 2013. Donc pour le mois d'observation Mai 2012 par exemple et le mois d'échéance Janvier 2012, l'indicateur que je calcule est le somme des impayés de Janvier à Mai 2012 divisée par la somme des échéances de Janvier à Mai 2012.
Je sais que j'ai du mal à m'expliquer, j'espère que le fichier excel est bien plus parlant.

D'autres internautes m'ont proposé une formule utilisant la fonction SOMMEPROD. La formule a marché sur quelques cellules, mais le temps de calcul est très lent ... Je suis donc obligée d'avoir recours au VBA.
Qu'en pensez vous ? :oops:

Je vous remercie d'avance de votre aide!
Excellente journée
17/06/2013, 11h59
vins86

Bonjour,

avec une sommeprod c'est possible.

Cordialement,

vincent
17/06/2013, 12h04
fatifatirose

Bonjour Vincent ! Merci pour la réponse
En effet, c'est possible, ça donne la formule suivante :
=SIERREUR(-1*SOMMEPROD((Feuil2!$G$2:$G$954056>=MOIS($B6))*(Feuil2!$G$2:$G$954056<=MOIS(O$3))*(Feuil2!$H$2:$H$954056>=ANNEE($B6))*(Feuil2!$H$2:$H$954056<=ANNEE(O$3))*(Feuil2!$I$2:$I$954056))/SOMMEPROD((Feuil2!$G$2:$G$954056>=MOIS($B6))*(Feuil2!$G$2:$G$954056<=MOIS(O$3))*(Feuil2!$H$2:$H$954056>=ANNEE($B6))*(Feuil2!$H$2:$H$954056<=ANNEE(O$3))*(Feuil2!$D$2:$D$954056));"")
Sachant que la colonne G est celle des mois, H celles des années, I celles des impayés et D celle des échéances.
Cependant, certaines cellules ne peuvent être remplies, par exemple celle correspondant à l'intersection Février 2012 et Janvier 2013, puisqu'elles ne vérifient pas toutes les conditions de la SOMMEPROD.
Sinon, un second problème se pose, celui du temps de calcul, mon fichier contient plus de 954000 observations ...
17/06/2013, 12h10
vins86

Pour le temps de calcul c'est avec une macro?
17/06/2013, 12h19
fatifatirose

Il s'agit juste de la fonction SOMMEPROD ...

Bonjour,

J'ai transposé la table en G1 de Feuil2. Vérifie l'exactitude des calculs (j'ai de gros doutes) et ensuite la durée d'exécution de la macro en temps réel.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub Calcul()
    Dim X As Integer, Y As Integer, MoisEch As Byte, MoisObs As Byte, An As Integer
    Dim inCalculationMode As Integer, Sh As Worksheet, Plage As Range
    Dim Plg As Range
    Application.ScreenUpdating = False
    inCalculationMode = Application.Calculation
'    Application.Calculation = xlCalculationManual
    Set Sh = Sheets("Feuil2")
    With Sheets("Feuil2")
        Set Plage = .Range(.[G1], .Cells(.Rows.Count, 7).End(xlUp)).Resize(, 4)
    End With
    With Sheets("Feuil1")
    .[C4:S20].ClearContents
    For X = 4 To .Cells(.Rows.Count, 2).End(xlUp).Row
        For Y = 3 To .Cells(3, .Columns.Count).End(xlToLeft).Column
            MoisEch = Month(.Cells(X, 2))
            MoisObs = Month(.Cells(3, Y))
            An = Year(.Cells(3, Y))
            Sh.AutoFilterMode = False
            Plage.AutoFilter 1, "<=" & MoisObs
            Plage.AutoFilter 2, "<=" & An
            Set Plg = Plage.Offset(1).Resize(Plage.Rows.Count - 1)
            If Application.Subtotal(103, Plg) > 0 Then
                .Cells(X, Y) = Application.Subtotal(109, Plg.Resize(, 1).SpecialCells(xlCellTypeVisible).Offset(, 2)) _
                / Application.Subtotal(109, Plg.Resize(, 1).SpecialCells(xlCellTypeVisible).Offset(, 3)) * -1
            End If
        Next Y
    Next X
    End With
    Application.Calculation = inCalculationMode
    Application.ScreenUpdating = True
End Sub

17/06/2013, 15h51
fatifatirose

Bonjour Daniel

Merci bcp pour ta réponse
J'essaie d'exécuter le code depuis plus de 15 minutes, en vain :(:(
17/06/2013, 16h01
Daniel.C

Quel est ton problème ?
17/06/2013, 17h17
fatifatirose

D'une part, je suis nulle quand il s'agit de VBA, donc, l'erreur vient sûrement de moi ... Et d'autre part, Excel Bug à chaque exécution ...
En gros, je dois écrire la formule suivante sous VBA, et je n'ai pas su le faire :oops:

=SIERREUR(-1*SOMMEPROD((DATA!$A$2:$A$954056="CREN")*(DATA!$C$2:$C$954056="CMR")*(DATA!$P$2:$P$954056>=Synthèse!$B7)*(DATA!$P$2:$P$954056<=Synthèse!D$4)*(DATA!$I$2:$I$954056))/SOMMEPROD((DATA!$A$2:$A$954056="CREN")*(DATA!$C$2:$C$954056="CMR")*(DATA!$P$2:$P$954056>=Synthèse!$B7)*(DATA!$P$2:$P$954056<=Synthèse!D$4)*(DATA!$D$2:$D$954056));"")

J'ai essayé de convertir celà en code VBA, mais je n'y arrive pas :/
17/06/2013, 17h23
Daniel.C

1 pièce(s) jointe(s)

Regarde le classeur joint et exécute la macro "Calcul".

ça n'ira pas plus vite en vba. Pourquoi ? Parce les fonctions de base excel sont optimisées et le langage est bien plus proche de la machine. Si tu veux impressionner tes amis
Code:

1 2 3 Worksheets("TaFeuille").range("Tonrange").FormulaLocal = "=SIERREUR(-1*SOMMEPROD((DATA!$A$2:$A$954056="CREN")*(DATA!$C$2:$C$954056="CMR")*(DATA!$P$2:$P$954056>=Synthèse!$B7)*(DATA!$P$2:$P$954056<=Synthèse!D$4)*(DATA!$I$2:$I$954056))/SOMMEPROD((DATA!$A$2:$A$954056="CREN")*(DATA!$C$2:$C$954056="CMR")*(DATA!$P$2:$P$954056>=Synthèse!$B7)*(DATA!$P$2:$P$954056<=Synthèse!D$4)*(DATA!$D$2:$D$954056));"")"

17/06/2013, 17h31
fatifatirose

Meeeerci bcp Daniel, je sais que je me fais lourde !
La macro s'exécute, mais le calcul quant à lui m'a l'air incorrect ... Je suis entrain de vérifier, bien que je n'arrive pas à saisir 1% du code :P

Bonjour Fati, bonjour Daniel

Je vous propose une autre variante utilisant les variables tableaux (testée sur le dernier fichier joint par Daniel)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Traitement()
Dim M As Integer, i As Integer, j As Integer
Dim N As Long, Ech As Long, Obs As Long
Dim BD, Tb
 
Application.ScreenUpdating = False
With Worksheets("Feuil2")
    N = .Cells(.Rows.Count, 7).End(xlUp).Row
    BD = .Range("G2:J" & N)
End With
 
With Worksheets("Feuil1")
    M = .Cells(.Rows.Count, 2).End(xlUp).Row - 2
    Tb = .Range("B3").Resize(M, M)
    .Range("C4").Resize(M - 1, M - 1).ClearContents
 
    For i = 2 To M
        Ech = Tb(i, 1)
        For j = 2 To M
            Obs = Tb(1, j)
            Tb(i, j) = S(BD, Ech, Obs)
        Next j
    Next i
 
    .Range("B3").Resize(M, M) = Tb
End With
End Sub
 
Private Function S(ByVal T, ByVal Ob As Long, ByVal Ec As Long) As Double
Dim Simp As Double, Sech As Double
Dim k As Long, P As Long, Tmp As Long
 
P = UBound(T, 1)
Ec = CLng(DateSerial(Year(Ec), Month(Ec) + 1, 1))
For k = 1 To P
    Tmp = CLng(DateSerial(T(k, 2), T(k, 1), 1))
    If Tmp >= Ob And Tmp < Ec Then
        Simp = Simp + Abs(Val(T(k, 3)))
        Sech = Sech + Val(T(k, 4))
    End If
Next k
If Sech <> 0 Then S = Simp / Sech
End Function