Fonction Sommeprod à 3 variables pour vba [Résolu/Fermé]

Signaler
Messages postés
30
Date d'inscription
jeudi 24 janvier 2013
Statut
Membre
Dernière intervention
30 mars 2018
-
Praljm
Messages postés
30
Date d'inscription
jeudi 24 janvier 2013
Statut
Membre
Dernière intervention
30 mars 2018
-
Bonjour,

Je peine à trouver la formule vba qui me permet d'avoir le résultat à partir de 3 conditions : (sumproduct ? sumif ? )


ma formule excel à convertir => =SOMMEPROD((A2:A27=1)*(D27:D27=380341)*(P2:P27="Eau")*(S2:S27))

Comment faire pour que le résultat apparaisse en cellule a28 ?

Ca marche très bien avec excel/sommeprod mais ça va être très long quand j'aurais 8000 lignes...

Merci d'avance
Cordialement.

8 réponses

Messages postés
16016
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 décembre 2019
2841
Bonjour,

Sommeprod étant une vraie-fausse formule matricielle, cela sera effectivement très long
je regarde une solution "rapide"
mais si tu pouvais joindre un extrait de ton classeur (1000 lignes )

pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
http://cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse
michel_m
Messages postés
16016
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 décembre 2019
2841
1° jet
Option Explicit
'ma formule excel à convertir => =SOMMEPROD((A2:A27=1)*(D27:D27=380341)*(P2:P27="Eau")*(S2:S27))
Sub sommeprod()
Dim Derlig As Integer, Tablo(), Idx As Integer, Somme As Double
Dim start As Single

start = Timer
Application.ScreenUpdating = False
Derlig = Columns("A").Find("*", , , , , xlPrevious).Row

Tablo = Range("A2:S" & Derlig).Value
For Idx = 1 To UBound(Tablo)
If Tablo(Idx, 1) = 1 Then
If Tablo(Idx, 4) = 380341 Then
If Tablo(Idx, 16) = "Eau" Then Somme = Somme + Tablo(Idx, 19)
End If
End If
Next
Cells(Derlig + 1, "A") = Somme
Application.ScreenUpdating = True
MsgBox "Calcul sur " & Derlig & " lignes effectué en : " & Timer - start & " Sec."

End Sub

Non testé

Mais suivant la structure de ton tableau, il serait peut-^tre + efficace de passer par 4 tableaux au lieu d'un (1 tableau par colonne: A, D,P,S)
michel_m
Messages postés
16016
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 décembre 2019
2841
Essai sur 2500 lignes avec que col A D, P,S remplies et conditions réunies
en environ 0,1 seconde avec 512 Mo RAM, Proc 3ghz celeron
Messages postés
16016
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 décembre 2019
2841
Essai 2500 lignes toutes colonnes remplies:
1 tableau=0,25 sec

Essai 8000 lignes
4 tableaux= 0,125 sec

code 4 tableaux
Option Explicit
'ma formule excel à convertir => =SOMMEPROD((A2:A27=1)*(D27:D27=380341)*(P2:P27="Eau")*(S2:S27))
Sub sommeprod()
Dim Derlig As Integer, T_a(), T_d(), T_p(), T_s(), Idx As Integer, Somme As Double
Dim start As Single

start = Timer
Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
With Application
.ScreenUpdating = False
T_a = .Transpose(Range("A2:A" & Derlig))
T_d = .Transpose(Range("D2:D" & Derlig))
T_p = .Transpose(Range("P2:P" & Derlig))
T_s = .Transpose(Range("S2:S" & Derlig))
End With

For Idx = 1 To UBound(T_a)
If T_a(Idx) = 1 Then
If T_d(Idx) = 380341 Then
If T_p(Idx) = "Eau" Then Somme = Somme + T_s(Idx)
End If
End If
Next
Cells(Derlig + 1, "A") = Somme
Application.ScreenUpdating = True
MsgBox "Calcul sur " & Derlig & " lignes effectué en : " & Timer - start & " Sec."

End Sub

En espèrant que Praljm daigne bien faire signe....

Michel
Messages postés
30
Date d'inscription
jeudi 24 janvier 2013
Statut
Membre
Dernière intervention
30 mars 2018

Bonjour,
Merci pour la réponse que je vais essayer de mettre en pratique.
Cordialement.
Messages postés
16016
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
13 décembre 2019
2841
Merci ?

Encore quelqu'un de correct ...

Décourageant....
Messages postés
30
Date d'inscription
jeudi 24 janvier 2013
Statut
Membre
Dernière intervention
30 mars 2018

Bonjour et merci pour toutes les propositions de programmation.
J'ai commencé à batir le futur fichier...
Bien cordialement,
A bientôt