Alléger le code VBA pour plus de rapidité

GwenLG

XLDnaute Nouveau
Bonjour à tous,
Je débute progressivement avec le VBA pour un projet, et il est temps pour moi de commencer avec mes questions :)

J'ai un programme qui sera assez important, le but sera de calculer des taux de complétude d'une base de données (+10k articles) il y a beaucoup d’exception et de cas particulier, donc je veux faire des fonctions et sub un peu indépendante pour pouvoir les appeler.
Mais voilà le code est lourd et prend beaucoup trop de temps. Pourriez vous m'aider et me donner des astuces pour améliorer mon code svp.
VB:
Option Explicit


'Fonction Qui Calcul le taux de complétude d'un SKU en fonction de la Famille qui l'accompagne
Function Taux_produit(ByVal SKU, Famille As String)

Dim BoEcran, BoBarre, BoEvent, BoSaut As Boolean
Dim iCalcul As Integer

' On conserve les données actuelles
BoEcran = Application.ScreenUpdating
BoBarre = Application.DisplayStatusBar
iCalcul = Application.Calculation
BoEvent = Application.EnableEvents
BoSaut = ActiveSheet.DisplayPageBreaks
' On force les configuration
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' CODE

            Dim Ligne_code As Integer 'Contiendra la ligne du SKU dans product
            Dim Last_row As Integer 'Dernière ligne des attributs dans la liste filtre
            Dim i As Integer 'Boucle for
            Dim Colonne_Attribut As Integer 'Colonne de l'attribut en cours de test
            Dim Liste As String 'Liste des attributs non renseignés
            Dim Attribut As String 'Attribut en cours de test
            Dim x As Range 'NC mais useful
            Dim Nb_attribut As Integer 'Nombre d'attributs renseigné pour le calcul du taux
            Dim Colonne_famille As Integer 'Colonne de la famille en cours de traitement

            Colonne_famille = Sheets("Filter").Range("A3:ZZ3").Find(Famille).Column
            
            Ligne_code = Sheets("Product").Range("A:A").Find(SKU).Row 'Pour savoir sur quelle ligne faire la recherche attribut
            Last_row = Sheets("Filter").Cells(Rows.Count, Colonne_famille).End(xlUp).Row - 3 'Pour connaître le nombre de tour de la boucle (=dernière ligne de la colonne de la famille)
            
            For i = 4 To Last_row
                    Attribut = Sheets("Filter").Cells(i, Colonne_famille).Value 'L'attribut qu'on va chercher s'il est présent
                    Set x = Sheets("Product").Rows("1").Find(Attribut) 'Utile pour passer outre l'erreur 91
                    If Not x Is Nothing Then Colonne_Attribut = x.Column 'La colonne ou se trouve l'attribut dans Product
                    
                    If Sheets("Product").Cells(Ligne_code, Colonne_Attribut).Value <> "" Then
                        Nb_attribut = Nb_attribut + 1 ' Si valeur présente on incrémente
                        Else:
                                If Liste <> "" Then Liste = Liste + "," + Attribut Else: Liste = Attribut 'Si valeur absente on ajoute à la liste pour plus tard
                    End If
            Next
            
            'Taux de complétude en %
             Taux = (Nb_attribut) / (Last_row - 1)
            
            
            
            
Application.ScreenUpdating = BoEcran
Application.DisplayStatusBar = BoBarre
Application.Calculation = iCalcul
Application.EnableEvents = BoEvent
ActiveSheet.DisplayPageBreaks = BoSaut
            
End Function

Ce code je veux l'appeler pour chaque article avec un code comme celui là :

VB:
Option Explicit

Sub Calcul_produit()

Dim SKU, Famille As String
Dim i As Integer
Dim J As Integer

Dim DataRange As Range

Set DataRange = Range("J1:J10000")


For i = 2 To 101
            Famille = Sheets("Data").Cells(i, 9)
            SKU = Sheets("Data").Cells(i, 7)
            Call Calcul_Taux.Taux_produit(SKU, Famille)
            DataRange(i, 1) = Taux
Next

'Range("J2:J10000").Value = DataRange

End Sub

Je vous remercie d'avance.

Gwen
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Dites vous bien qu'un accès a la valeur d'une plage d'après la propriété Value d'un Range qui la représente est une opération longue à exécuter et qu'il faut s'en servir le moins souvent possible. Sa durée d'exécution est presque indépendante du nombre de cellules de la plage. La Value d'un Range de plusieurs cellules est un tableau dynamique de Variant basé 1, à 2 dimensions même quand la plage n'a qu'une seule ligne ou colonne. une fois le tableau chargé, l'accès à un de ses éléments est très rapide.
 

Dranreb

XLDnaute Barbatruc
On peut dire que j'ai complètement banni l'emploi de Cells(L, C).Value, L et C étant respectivement un numéro de ligne et un numéro de colonne, de même que Range ou Evaluate pour une seule cellule (sauf évidemment si je n'ai en tout et pour tout que cette cellule là à traiter). Même pour de petites plages je préfère passer par des tableaux dynamiques. Il n'y a que deux accès aux plages de cellules dans cet exemple: un au début et un à la fin :
VB:
Sub SansLesFormules()
   Dim TDon(), TRés(), TSeuils(), L As Long
   TDon = Feuil1.[C4:E13].Value
   ReDim TRés(1 To UBound(TDon, 1), 1 To 2)
   TSeuils = Array(0, 10, 12, 16)
   For L = 1 To UBound(TDon, 1)
      If TDon(L, 1) = "Licence" Then
         TRés(L, 1) = 0.25 * TDon(L, 2) + 0.75 * TDon(L, 3)
      Else
         TRés(L, 1) = 0.35 * TDon(L, 2) + 0.65 * TDon(L, 3)
         End If
      TRés(L, 2) = Choose(WorksheetFunction.Match(TRés(L, 1), TSeuils), "Ajourné", "Assez Bien", "Bien", "Très Bien")
      Next L
   Feuil1.[H4:I13].Value = TRés
   End Sub
Le même code écrit à coups de Feuil1.Cells(L, C) aurait duré 30 fois plus longtemps parce que j'aurait eu 60 accès de cellule au lieu de 2.
 
Dernière édition:

Discussions similaires