Microsoft 365 Convertir formule Excel en VBA

[etpisculrien]

Bonjour à vous les expert(e)s

J'aurais besoin de vous concernant un projet car je ne trouve pas où est l'erreur dans mon code. Je vous explique :
J'ai une formule sur une feuille Excel qui me permet de faire un "genre de RechercheV entre 2 dates", ce pour identifier l'utilisateur d'un véhicule en fonction de la date. La formule fonctionne très bien mais est très gourmande en ressource ce qui fait que cela met un temps infini pour calculer la feuille (j'ai près de 10000 lignes).
Du coup, pour que ça aille plus vite, j'essaie de convertir ma formule en VBA pour pouvoir la traiter dans un tableau-Array, ce qui devrait être beaucoup plus rapide.

Là où je bloque c'est pour convertir la formule suivante : =SIERREUR(@INDIRECT("'Date_vehicule'!D"&SOMMEPROD(((Date_vehicule!A:A)=I2)*(A2>=(Date_vehicule!B:B))*(A2<=(Date_vehicule!C:C));LIGNE(Date_vehicule!D)));"")
en une formule VBA à intégrer dans mon code suivant :

Sub FORMULE()

Dim TABLE, I As Integer

TABLE = Range("A2:M1000").Value
For I = 1 To 999

TABLE(I, 1) = WorksheetFunction.INDIRECT(Sheets("Date_vehicule").Range("D") & WorksheetFunction.SumProduct(((Sheets("Date_vehicule").Range("A:A")) = TABLE(I, 9)) * (TABLE(I, 1) >= (Sheets("Date_vehicule").Range("B:B"))) * (TABLE(I, 1) <= (Sheets("Date_vehicule").Range("C:C"))), WorksheetFunction.Row(Sheets("Date_vehicule").Range("D"))))

Next I

Range("M2:M1000").Value = TABLE

End Sub

Si quelqu'un pouvait m'aider, je n'ai plus de cheveux et je commence à attaquer la peau de mon crâne...

Merci d'avance

Je mets un exemple de mon fichier pour mieux comprendre (PS : éviter de lancer le calcul sinon ça risque de prendre du temps)

 

[Dranreb]

Bonjour.
La fonction SOMMEPROD ainsi que la WorkseetFunction.SumProduct ne font strictement que la somme des produits des arguments spécifiés. Si donc les argument doivent être construits en amont, vous devez, en VBA, vous en charger. Excel n'est pas là pour pré-traiter les expressions matricielles spécifiées avant de l'invoquer. Mais la méthode Evaluate le peut …

 

[etpisculrien]

Merci pour ton intérêt et ta réponse Dranreb, je vais réfléchir comment construire les arguments en amont... A moins que, ta solution avec Evaluate soit plus simple... Elle consiste en quoi? Comment puis-je l'intégrer dans ma macro, ma formule?

 

[etpisculrien]

Personne d'autre pour m'aider svp? Il doit y avoir une virgule ou un truc mal placé, je bug total

 

[Dranreb]

Elle consiste en une méthode de l'objet Application ou de l'objet Worksheet qui renvoie le résultat de l'évaluation par Excel d'un String reproduisant une expression de formule. Si cette expression est fixe c'est à dire non formée par concaténation de variables et de constantes String, il existe une façon simplifiée de l'invoquer, en la spécifiant entre crochets droits mais sans délimiteur. Un nom du gestionnaire de noms entre crochets droit peut par exemple renvoyer le Range de référence.

 

[etpisculrien]

un truc genre
TABLE(I, 1) = [INDIRECT("'Date_vehicule'!D"&SOMMEPROD(((Date_vehicule!A:A)=I2)*(A2>=(Date_vehicule!B:B))*(A2<=(Date_vehicule!C:C));LIGNE(Date_vehicule!D : D)))]

ou plutot

TABLE(I, 1) = WorksheetFunction.INDIRECT([Sheets("Date_vehicule").Range("D")] & WorksheetFunction.SumProduct((([Sheets("Date_vehicule").Range("A:A")]) = TABLE(I, 9)) * (TABLE(I, 1) >= ([Sheets("Date_vehicule").Range("B:B")])) * (TABLE(I, 1) <= ([Sheets("Date_vehicule").Range("C:C")])), WorksheetFunction.Row([Sheets("Date_vehicule").Range("D: D")])))

j'ai essayé aussi ça mais ça ne fonctionne pas non plus :
TABLE(I, 1) = Evaluate(INDIRECT(""'Date_vehicule'!D""&SUMPRODUCT(((Date_vehicule!C[-12])=RC[-4])*(RC[-12]>=(Date_vehicule!C[-11]))*(RC[-12]<=(Date_vehicule!C[-10])),ROW(Date_vehicule!C[-9]))))

Je suis désolé mais je t'avoue que je ne suis pas aussi expert que toi et je tâtonne

 

[Dranreb]

Non: 'Sheets("Date_vehicule").Range("D")' ne serait pas compris s'il figurait dans une formule de cellule et ne peut donc être évalué pas cette méthode.

 

[etpisculrien]

c'est pourquoi je ne comprends pas pourquoi cette méthode ne fonctionne pas.
TABLE(I, 1) = Evaluate(INDIRECT(""'Date_vehicule'!D""&SUMPRODUCT(((Date_vehicule!C[-12])=RC[-4])*(RC[-12]>=(Date_vehicule!C[-11]))*(RC[-12]<=(Date_vehicule!C[-10])),ROW(Date_vehicule!C[-9]))))

j'ai pourtant enregistré la macro avec cette formule qui fonctionne dans la cellule et recopié dans VBA avec Evaluate devant mais rien n'y fait

 

[Dranreb]

Déjà on n'a jamais besoin de Indirect ni index en vba. Après je ne sais pas ce que ça devrait faire même dans votre formule !
Ne faites pas des SOMMEPROD sur des colonnes entières !

 

[etpisculrien]

ok, merci quand même

 

[Dranreb]

Concrètement qu'est ce que vous voudriez qu'elle fasse votre macro FORMULEQUATER ?

Remarque: je crois que j'ai compris:
Vous voulez trouver le responsable de chaque Code dans la période contenant la Date
Hmmm … Plus compliqué qu'il n'y parait. Je vais chercher.

 

[Dranreb]

Bon je pense que je le ferais tout simplement comme ça :

Sub FORMULEQUATER()
   Dim TPério(), TDate(), TCode(), TResp(), LD As Long, LR As Long
   TPério = Feuil3.[A1].CurrentRegion.Value
   TDate = Feuil10.[A2].Resize([A1000000].End(xlUp).Row - 1).Value
   TCode = Feuil10.[I2].Resize(UBound(TDate, 1)).Value
   ReDim TResp(1 To UBound(TDate, 1), 1 To 1)
   For LR = 1 To UBound(TResp, 1)
      For LD = 1 To UBound(TPério, 1)
         If TCode(LR, 1) = TPério(LD, 1) And TDate(LR, 1) >= TPério(LD, 2) And TDate(LR, 1) _
            <= TPério(LD, 3) Then TResp(LR, 1) = TPério(LD, 4): Exit For
         Next LD, LR
   Feuil10.[M2].Resize(UBound(TResp)).Value = TResp
   End Sub

Toutefois si le volume de données devait être bien plus important il vaudrait mieux utiliser un Dictionary au moins pour les Code afin d'éviter le plus gros de ces deux boucles imbriquées …

 

[etpisculrien]

Bon je pense que je le ferais tout simplement comme ça :

Sub FORMULEQUATER()
   Dim TPério(), TDate(), TCode(), TResp(), LD As Long, LR As Long
   TPério = Feuil3.[A1].CurrentRegion.Value
   TDate = Feuil10.[A2].Resize([A1000000].End(xlUp).Row - 1).Value
   TCode = Feuil10.[I2].Resize(UBound(TDate, 1)).Value
   ReDim TResp(1 To UBound(TDate, 1), 1 To 1)
   For LR = 1 To UBound(TResp, 1)
      For LD = 1 To UBound(TPério, 1)
         If TCode(LR, 1) = TPério(LD, 1) And TDate(LR, 1) >= TPério(LD, 2) And TDate(LR, 1) _
            <= TPério(LD, 3) Then TResp(LR, 1) = TPério(LD, 4): Exit For
         Next LD, LR
   Feuil10.[M2].Resize(UBound(TResp)).Value = TResp
   End Sub

Toutefois si le volume de données devait être bien plus important il vaudrait mieux utiliser un Dictionary au moins pour les Code afin d'éviter le plus gros de ces deux boucles imbriquées …

Dranreb, tu es hallucinant!!!!! Ton code marche à la perfection, et dans un délai qui n'a plus rien à voir!
Je te remercie vraiment pour ton aide, tu es dans une autre dimension que moi coté code (j'ai encore beaucoup à apprendre

Encore merci