En VBA calcul avec conditions, quel est le plus rapide ?

  • Initiateur de la discussion Compte Supprimé 979
  • Date de début
C

Compte Supprimé 979

Guest
Bonjour à toutes et à tous,

Petite question du jour pour les pros ;)

En VBA quel est le plus rapide :
1) calculer un résultat avec une formule matricielle et un evaluate()
2) remplir un tableau à 2 dimension et faire les calculs sur ce tableau ?

Voici le code actuel, ou j'utilise pour le moment les 2
Code:
Public Function MtFRA_FMA(NomFeuille As String)  Dim DLig As Long, sForm As String, Ind As Long, Tblo() As Variant
  Dim Result As Double, TxFRA As Double, TxFMA As Double
  ' Recalculer à chaque modification
  Application.Volatile
  ' Initialiser les variables
  Result = 0: sForm = ""
  ' Dernière ligne de la feuille détail
  DLig = ThisWorkbook.Sheets("Détail").Range("A" & Rows.Count).End(xlUp).Row
  ' En cas d'erreur
  On Error Resume Next
  ' # Modification du 20/05/2015
  ' montant des FRA calculé sur MOe Production
  If InStr(1, UCase(VParam("Préfixe_eOTP")), "SO") > 0 Then
    ' Définir le tableau
    ReDim Tblo(DLig - 1, 11)
    Tblo = ThisWorkbook.Sheets("Détail").Range("A2:K" & DLig).Value
    ' Parcourir le tableau pour calculer les FRA/FMA
    For Ind = LBound(Tblo) To UBound(Tblo)
      If InStr(1, "I302,I303,I306,I304,I310,I305,I311,E302", Tblo(Ind, 4)) > 0 Then
        Result = Result + (Tblo(Ind, 10) * Tblo(Ind, 11))
      End If
    Next Ind
    GoTo Suite
  End If
  ' Sinon, selon la prise ne compte du type de Main d'oeuvre
  If UCase(VParam("CalculTxFRAFMA")) = "NON" Then
    ' Préparer la formule
    sForm = "=SUMPRODUCT((Détail!A$2:A$" & DLig & "=""" & NomFeuille & """)"
    sForm = sForm & "*(LEFT(Détail!E$2:E$" & DLig & ",2)= ""MO"")"
    sForm = sForm & "*(Détail!J$2:J$" & DLig & ")*(Détail!K$2:K$" & DLig & "))"
    ' Calculer el résultat de la formule
    Result = Application.Evaluate(sForm)
  Else
    ' Préparer la formule
    sForm = "=SUMPRODUCT((Détail!A$2:A$" & DLig & "=""" & NomFeuille & """)"
    sForm = sForm & "*(Détail!E$2:E$" & DLig & "= ""MOI"")"
    sForm = sForm & "*(Détail!J$2:J$" & DLig & ")*(Détail!K$2:K$" & DLig & "))"
    ' Calculer le résultat de la formule
    Result = Application.Evaluate(sForm)
  End If
Suite:
  ' Récupérer les 2 taux
  TxFRA = VParam("TauxFRA"): TxFMA = VParam("TauxFMA")
  ' Calculer le montant
  MtFRA_FMA = (Result * TxFRA) + (Result * TxFMA)
  ' Rétablir la gestion d'erreur
  On Error GoTo 0
End Function

Merci d'avance pour vos réponse

A+
 
C

Compte Supprimé 979

Guest
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Bonsoir messieurs ;)

Après test 588.000 lignes, il s'avère que le calcul par formule est 2 fois plus rapide qu'avec le tablo
Il est vrai aussi que j'utilise une boucle pour mon tablo

Petit fichier joint pour mister Staple1600 ;)

A+
 

Pièces jointes

  • TempsCalcul.xlsm
    53.5 KB · Affichages: 46

Staple1600

XLDnaute Barbatruc
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Re

BrunoM45
Il manque la feuille Planning initial, non ?
Parce que si j'ajoute une feuille vierge et que je la renomme Planning initial, le MsgBox affiche 00:00:00
ce qui effectivement est très rapide ;)
 

ROGER2327

XLDnaute Barbatruc
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Bonjour à tous.

Tant qu'à utiliser les tableaux, autant les faire aussi légers que possible :​
Code:
Public Function MtFRA_FMA(NomFeuille As String)
  Dim DLig As Long, sForm As String, Ind As Long, Tblo1() As Variant, Tblo2() As Variant
  Dim Result As Double, TxFRA As Double, TxFMA As Double
  Dim Tps1 As Single, Tps2 As Single
  ' Mémoriser l'heure de départ
  Tps1 = Timer
  ' Recalculer à chaque modification
  Application.Volatile
  ' Initialiser les variables
  Result = 0: sForm = ""
  ' Dernière ligne de la feuille détail
  DLig = ThisWorkbook.Sheets("Détail").Range("A" & Rows.Count).End(xlUp).Row
  ' En cas d'erreur
  On Error Resume Next
  ' # Modification du 20/05/2015
  ' Pour RSO montant des FRA calculé sur MOe Production
  If InStr(1, UCase(VParam("Préfixe_eOTP")), "SO") > 0 Then

    ' Définir les tableaux
    Tblo1 = ThisWorkbook.Sheets("Détail").Range("D2:D" & DLig).Value
    Tblo2 = ThisWorkbook.Sheets("Détail").Range("J2:K" & DLig).Value
    ' Parcourir le tableau pour calculer les FRA/FMA
    For Ind = LBound(Tblo1) To UBound(Tblo1)
      If InStr(1, "I302,I303,I306,I304,I310,I305,I311,E302", Tblo1(Ind, 1)) > 0 Then
        Result = Result + (Tblo2(Ind, 1) * Tblo2(Ind, 2))
      End If
    Next Ind

    GoTo Suite
  End If
  ' Sinon, selon la prise ne compte du type de Main d'oeuvre
  If UCase(VParam("CalculTxFRAFMA")) = "NON" Then
    ' Préparer la formule
    sForm = "=SUMPRODUCT((Détail!A$2:A$" & DLig & "=""" & NomFeuille & """)"
    sForm = sForm & "*(LEFT(Détail!E$2:E$" & DLig & ",2)= ""MO"")"
    sForm = sForm & "*(Détail!J$2:J$" & DLig & ")*(Détail!K$2:K$" & DLig & "))"
    ' Calculer el résultat de la formule
    Result = Application.Evaluate(sForm)
  Else
    ' Préparer la formule
    sForm = "=SUMPRODUCT((Détail!A$2:A$" & DLig & "=""" & NomFeuille & """)"
    sForm = sForm & "*(Détail!E$2:E$" & DLig & "= ""MOI"")"
    sForm = sForm & "*(Détail!J$2:J$" & DLig & ")*(Détail!K$2:K$" & DLig & "))"
    ' Calculer le résultat de la formule
    Result = Application.Evaluate(sForm)
  End If
Suite:
  ' Récupérer les 2 taux
  TxFRA = 0.025: TxFMA = 0.03
  ' Calculer le montant
  MtFRA_FMA = (Result * TxFRA) + (Result * TxFMA)
  ' Rétablir la gestion d'erreur
  On Error GoTo 0
  ' Inscrire l'heure de début et de  fin
  Tps2 = Timer
  MsgBox "Durée du calcul : " & Round((Tps2) - Tps1 - 86400 * (Tps2 < Tps1), 3) & " s"
End Function

Maintenant, s'agissant de comparer les performances de deux méthodes, il convient peut-être de veiller à ce que les deux méthodes calculent la même chose !

Par exemple :​
Code:
Public Function MtFRA_FMA1(NomFeuille As String)
  Dim DLig As Long, sForm As String, Ind As Long, Tblo1() As Variant, Tblo2() As Variant, Tblo3() As Variant
  Dim Result As Double, TxFRA As Double, TxFMA As Double
  Dim Tps1 As Single, Tps2 As Single
  Tps1 = Timer
  Application.Volatile
  DLig = ThisWorkbook.Sheets("Détail").Range("A" & Rows.Count).End(xlUp).Row
  On Error Resume Next

  If InStr(1, UCase(VParam("Préfixe_eOTP")), "SO") > 0 Then

    Tblo1 = ThisWorkbook.Sheets("Détail").Range("A2:A" & DLig).Value
    Tblo2 = ThisWorkbook.Sheets("Détail").Range("E2:E" & DLig).Value
    Tblo3 = ThisWorkbook.Sheets("Détail").Range("J2:K" & DLig).Value
    If UCase(VParam("CalculTxFRAFMA")) = "NON" Then
      For Ind = LBound(Tblo1) To UBound(Tblo1)
        If Left$(Tblo2(Ind, 1), 2) = "MO" Then
          If Tblo1(Ind, 1) = NomFeuille Then Result = Result + (Tblo3(Ind, 1) * Tblo3(Ind, 2))
        End If
      Next Ind
    Else
      For Ind = LBound(Tblo1) To UBound(Tblo1)
        If Tblo2(Ind, 1) = "MOI" Then
          If Tblo1(Ind, 1) = NomFeuille Then Result = Result + (Tblo3(Ind, 1) * Tblo3(Ind, 2))
        End If
      Next Ind
    End If

  Else

    sForm = "=SUMPRODUCT((Détail!A$2:A$" & DLig & "=""" & NomFeuille & """)"
    If UCase(VParam("CalculTxFRAFMA")) = "NON" Then
      sForm = sForm & "*(LEFT(Détail!E$2:E$" & DLig & ",2)= ""MO"")"
    Else
      sForm = sForm & "*(Détail!E$2:E$" & DLig & "= ""MOI"")"
    End If
    sForm = sForm & "*(Détail!J$2:J$" & DLig & ")*(Détail!K$2:K$" & DLig & "))"
    Result = Application.Evaluate(sForm)

  End If

  TxFRA = 0.025: TxFMA = 0.03
  MtFRA_FMA1 = (Result * TxFRA) + (Result * TxFMA)
  On Error GoTo 0
  Tps2 = Timer
  MsgBox "Durée du calcul (1) : " & Round((Tps2) - Tps1 - 86400 * (Tps2 < Tps1), 3) & " s"
End Function

Ou :​
Code:
Public Function MtFRA_FMA2(NomFeuille As String)
  Dim DLig As Long, sForm As String, Ind As Long, Tblo1() As Variant, Tblo2() As Variant
  Dim Result As Double, TxFRA As Double, TxFMA As Double
  Dim Tps1 As Single, Tps2 As Single
  Tps1 = Timer
  Application.Volatile
  DLig = ThisWorkbook.Sheets("Détail").Range("A" & Rows.Count).End(xlUp).Row
  On Error Resume Next

  If InStr(1, UCase(VParam("Préfixe_eOTP")), "SO") > 0 Then

    Tblo1 = ThisWorkbook.Sheets("Détail").Range("D2:D" & DLig).Value
    Tblo2 = ThisWorkbook.Sheets("Détail").Range("J2:K" & DLig).Value
    For Ind = LBound(Tblo1) To UBound(Tblo1)
      If InStr(1, "I302,I303,I306,I304,I310,I305,I311,E302", Tblo1(Ind, 1)) > 0 Then
        Result = Result + (Tblo2(Ind, 1) * Tblo2(Ind, 2))
      End If
    Next Ind

  Else

    sForm = "=SUMPRODUCT((SEARCH(Détail!D$2:D$" & DLig & ",""I302,I303,I306,I304,I310,I305,I311,E302,""&Détail!D$2:D$" & DLig & ")<40)*Détail!J$2:J$" & DLig & "*Détail!K$2:K$" & DLig & ")"
    Result = Application.Evaluate(sForm)

  End If

  TxFRA = 0.025: TxFMA = 0.03
  MtFRA_FMA2 = (Result * TxFRA) + (Result * TxFMA)
  On Error GoTo 0
  Tps2 = Timer
  MsgBox "Durée du calcul (2) : " & Round((Tps2) - Tps1 - 86400 * (Tps2 < Tps1), 3) & " s"
End Function


Bonne journée.


ℝOGER2327
#7879


Mercredi 4 Merdre 142 (Nativité de Saint Henri Rousseau, douanier - fête Suprême Quarte)
2 Prairial An CCXXIII, 1,3515h - hémérocalle
2015-W21-4T03:14:37Z
 
C

Compte Supprimé 979

Guest
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Salut Staple1600

Il manque la feuille Planning initial, non ?
Parce que si j'ajoute une feuille vierge et que je la renomme Planning initial, le MsgBox affiche 00:00:00
ce qui effectivement est très rapide ;)
Non la feuille Planning Initial n'est pas obligatoire puisque tout est calculé avec la feuille [Détail]
Quant au temps, il n'est effectivement pas toujours juste ;)

A+
 
C

Compte Supprimé 979

Guest
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Bonjour Roger2327

Merci pour les infos, mais les 2 méthodes qui sont dans ma fonction sont bien des calculs différents selon 2 paramètres ;)

C'était pour savoir si le 2ème calcul je le faisait sous forme de tableau également, mais pour moi ce n'est pas concluant

A+
 

ROGER2327

XLDnaute Barbatruc
Re : En VBA calcul avec conditions, quel est le plus rapide ?

Re...


(...)
Merci pour les infos, mais les 2 méthodes qui sont dans ma fonction sont bien des calculs différents selon 2 paramètres ;)
Merci (;)), je m'en doutais un peu.​


(...)
C'était pour savoir si le 2ème calcul je le faisait sous forme de tableau également, mais pour moi ce n'est pas concluant
(...)
Pour le savoir, j'ai écrit MtFRA_FMA1. Ce qui montre que la vitesse d'exécution de la solution par tableaux est du même ordre que celle de la solution par formule : pour vos données reproduites sur 881 664 lignes et par rapport à la solution par tableaux, la solution par formule gagne ~15% si A2 contient Oui et perd ~15% si A2 contient Non.​


Bonne journée.


ℝOGER2327
#7880


Mercredi 4 Merdre 142 (Nativité de Saint Henri Rousseau, douanier - fête Suprême Quarte)
2 Prairial An CCXXIII, 3,5601h - hémérocalle
2015-W21-4T08:32:39Z
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla