Microsoft 365 Convertir formule Excel en VBA

etpisculrien

XLDnaute Occasionnel
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: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: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)
 

Pièces jointes

  • Formule Excel vers VBA.xlsm
    19.2 KB · Affichages: 10
Solution
Bon je pense que je le ferais tout simplement comme ça :
VB:
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...

Dranreb

XLDnaute Barbatruc
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 …
 

Dranreb

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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
 

etpisculrien

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Bon je pense que je le ferais tout simplement comme ça :
VB:
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

XLDnaute Occasionnel
Bon je pense que je le ferais tout simplement comme ça :
VB:
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
 

Discussions similaires

Réponses
6
Affichages
202
Réponses
12
Affichages
225

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof