Remplacer une formule sommeprod en code vba

[Rhaly]

Bonjour à tous et au forum!

Je cherche à remplacer mes formules sommeprod (qui ont l'air de me ralentir l'original de mon fichier) en macro.

J'ai trouvé sur le forum une macro que j'ai essayé de mettre à ma sauce mais je me suis perdu dedans et j'arrive plus à m'y retrouver

La formule initiale est :

=SI(SOMMEPROD((CONSEILLER!$A$7:$A$500=$A$4)*(CONSEILLER!$D$7:$D$500=$K$4)*(CONSEILLER!F$7:F$500<>""))=0;"-";SOMMEPROD((CONSEILLER!$A$7:$A$500=$A$4)*(CONSEILLER!$D$7:$D$500=$K$4)*(CONSEILLER!F$7:F$500<>"")))

Je vous remercie d'avance!

 

[Gorfael]

Re : Remplacer une formule sommeprod en code vba

Salut Rhaly et le forum
Une proposition avec filtre :

Sub test()
Dim Plage As Range, Cel As Range
Dim F As Worksheet, X As Long

Set F = Sheets("CONSEILLER 2")
Set Plage = F.Range("A6").CurrentRegion

If F.FilterMode Then F.ShowAllData
Plage.AutoFilter Field:=1, Criteria1:=F.Range("A4")
Plage.AutoFilter Field:=4, Criteria1:=F.Range("K4")
Plage.AutoFilter Field:=6, Criteria1:="<>"
X = Plage.Columns(1).SpecialCells(xlCellTypeVisible).Count - 2
End Sub

On effectue un filtrage sur les critères donnés.
on retire les deux cellules de titre (A5 et A6) et on compte le nombre de cellules visibles : X contient le résultat => il suffit de faire un test sur X=0 pour satisfaire à la demande, mais n'ayant pas d'autres informations, faudra que tu t'en débrouilles.
A+

 

[Rhaly]

Re : Remplacer une formule sommeprod en code vba

Oops désole, c'est vrai que j'ai pas été précis. La formule sommeprod citée est, à l'origine, dans la feuille PROD celulle B6.
Elle me donne le nombre de "validé" ('Conseiller'!H7:H500) du conseiller à la date ('PROD'!B4) si le type (A7:A500) est = à "PROD A"
J'avais essayé de faire une macro trouvé sur le forum que j'ai mise dans le module 1 :



Public Sub UpdateNomDefini()
Dim Rng As Range, L As Integer

With Worksheets("VANDERHAEGHE Marine")
L = .Range("D500").End(xlUp).Row
' Set Rng = .Range("A1:Y" & L)
' Rng.Name = "BD"
Set Rng = .Range("A7:A" & L)
Rng.Name = "ColA"

Set Rng = .Range("D7" & L)
Rng.Name = "ColD"

Set Rng = .Range("F7:F" & L)
Rng.Name = "ColF"

End With

Set Rng = Nothing

End Sub

Public Sub Calcule()
Dim L As Long, DerL As Long, E As String, B As String, C As String

Application.ScreenUpdating = False
With Worksheets("DMT PARC")
DerL = .Range("D65536").End(xlUp).Row
A = .Range("A5"): B = .Range("B30"): F = .Range("F30"): K = .Range("K30"): O = .Range("O30"): T = .Range("T30"): X = .Range("X30"): V = .Range.IsEmpty
For L = 7 To DerL
E = .Range("E3"): C = .Range("C" & L)
.Cells(L, 5) = Evaluate("sumproduct((ColA=""" & A & """)*(ColD=""" & B & """)*(ColF=""" & V & """ ))")
E = .Range("F3")
.Cells(L, 6) = Evaluate("sumproduct((ColG=""" & E & """)*(ColI=""" & C & """)*(ColH=""" & B & """))")
E = .Range("G3")
.Cells(L, 7) = Evaluate("sumproduct((ColG=""" & E & """)*(ColI=""" & C & """)*(ColH=""" & B & """))")
E = .Range("H3")
.Cells(L, 8) = Evaluate("sumproduct((ColG=""" & E & """)*(ColI=""" & C & """)*(ColH=""" & B & """))")
Next
Application.ScreenUpdating = True

End With

MAis je vais essayé avec ta méthode si j'y arrive mieux!