Lenteur VBA en calcul sur RAM

Le 04/03/2025 à 13:22

Bonjour,

malgré l'optimisation de mes macro et l'utilisation de méthode pour calculer directement via la RAM avec des variant, mon pc met une paye à calculer et coller les valeurs dans mon tableur, j'ai pourtant 32Gb de ram, aucune surcharge de CPU, de RAM ou autre, même au niveau de la taille du fichier, j'ai fais un test sur une seule colonne de calcul en Xlookup avec unecondition IF() simple, deux table de 60000 lignes chacunes, le calcul à pourtant mis 3 minutes environ, le soucis c'est que je dois créer un code qui comprendra au final 43 colonne à recalculer, si j'ai 3 minutes par colonne j'aurais un temps de calcul de plus de 100 minutes en finalité.

voici le code travaillé et retravaillé par moi, puis corrigé et optimisé au maximum que j'ai pu via chatGPT et github.com

Sub Update_Mst_Data()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim SAP As Variant
Dim Mstdata As Variant

Dim i As Long
Dim lastRowsap As Long
Dim lastRowmst As Long

Dim resultat_S() As Variant
Dim xlookup_result As Variant

' Définir les feuilles de travail
Set ws1 = ThisWorkbook.Sheets("SAP")
Set ws2 = ThisWorkbook.Sheets("MstData")

' Charger les données des tables en mémoire
SAP = ws1.ListObjects("SAP").DataBodyRange.Value
Mstdata = ws2.ListObjects("Masterdata").DataBodyRange.Value

' Trouver la dernière ligne de chaque feuille
lastRowsap = UBound(SAP, 1)
lastRowmst = UBound(Mstdata, 1)

' Initialiser le tableau pour les résultats
ReDim resultat_S(1 To lastRowmst, 1 To 1)

' Créer un dictionnaire pour accélérer la recherche
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim key As Variant

' Charger les données SAP dans le dictionnaire
For i = 1 To lastRowsap
key = SAP(i, 4) ' Colonne D de SAP (4ème colonne)
If Not IsEmpty(key) Then
dict(key) = SAP(i, 2) ' Colonne B de SAP (2ème colonne)
End If
Next i

' Boucle pour traiter chaque ligne de Mstdata
For i = 1 To lastRowmst
key = Mstdata(i, 3) ' Colonne C de Mstdata (3ème colonne)
If dict.exists(key) Then
xlookup_result = dict(key)
If Mstdata(i, 2) <> xlookup_result Then
resultat_S(i, 1) = xlookup_result
Else
resultat_S(i, 1) = Mstdata(i, 2)
End If
Else
resultat_S(i, 1) = Mstdata(i, 2) ' Si clé non trouvée, garder la valeur d'origine
End If
Next i

' Écrire les résultats en une seule opération
ws2.Range("S3:S" & lastRowmst + 2).Value = resultat_S

MsgBox "Mise à jour terminée !", vbInformation

End Sub

si quelqu'un peu m'aider...?

Le 04/03/2025 à 14:06

Bonjour et bienvenue,

Pour info, je pense qu'il est possible de réaliser ce processus sans VBA (via formules ou PQ). L'avantage est que vous aurez accès au calculs en parallèles alors que VBA est exécuté sur un seul coeur.

Ensuite pour le code je vous propose les optimisations ci-dessous. Une autre optimisation très importante (que je n'ai pas faite) serait de typer vos variables. Si vous savez que vous ne travaillez qu'avec des nombres ou qu'avec des strings, il peut être intéressant de re-cast vos tableaux SAP et MstData avant de calculer quoi que ce soit ça va accélérer la suite du code.

Sub Update_Mst_Data()

  Dim ws1 As Worksheet
  Dim ws2 As Worksheet
  Dim SAP As Variant
  Dim Mstdata As Variant

  Dim i As Long
  Dim lastRowsap As Long
  Dim lastRowmst As Long

  Dim resultat_S() As Variant
  Dim xlookup_result As Variant

  ' Définir les feuilles de travail
  Set ws1 = ThisWorkbook.Sheets("SAP")
  Set ws2 = ThisWorkbook.Sheets("MstData")

  ' Charger les données des tables en mémoire
  SAP = ws1.ListObjects("SAP").DataBodyRange.Value
  Mstdata = ws2.ListObjects("Masterdata").DataBodyRange.Value

  ' Trouver la dernière ligne de chaque feuille
  lastRowsap = UBound(SAP, 1)
  lastRowmst = UBound(Mstdata, 1)

  ' Initialiser le tableau pour les résultats
  ReDim resultat_S(1 To lastRowmst, 1 To 1)

  ' Créer un dictionnaire pour accélérer la recherche
  Dim dict As Object
  Set dict = CreateObject("Scripting.Dictionary")
  Dim key As Variant

  ' Charger les données SAP dans le dictionnaire
  For i = 1 To lastRowsap
    key = SAP(i, 4)                              ' Colonne D de SAP (4ème colonne)

    ' If Not IsEmpty(key) Then '???
    '   dict(key) = SAP(i, 2)                      ' Colonne B de SAP (2ème colonne)
    ' End If
    ' cette partie est incorrecte. Key n'est Empty que pour la 1e boucle avant son initialization.
    ' il faudrait plutot tester si key different de 0 ou vbNullString
    ' soit :
    If key <> 0 Then dict(key) = SAP(i, 2)
  Next i

  ' Boucle pour traiter chaque ligne de Mstdata
  For i = 1 To lastRowmst
    key = Mstdata(i, 3)                          ' Colonne C de Mstdata (3ème colonne)
    'If dict.exists(key) Then
    '  xlookup_result = dict(key)
    '  If Mstdata(i, 2) <> xlookup_result Then   ' inutile, resultat = xlookup
    '    resultat_S(i, 1) = xlookup_result
    '  Else
    '    resultat_S(i, 1) = Mstdata(i, 2)
    '  End If
    'Else
    '  resultat_S(i, 1) = Mstdata(i, 2)           ' Si clé non trouvée, garder la valeur d'origine
    'End If
    ' les tests ci-dessus sont redondants et inutiles
    ' un peu de logique montre que l'instruction ci-dessous est équivalente:
    If dict.exists(key) Then
      resultat_S(i, 1) = dict(key)
    Else
      resultat_S(i, 1) = Mstdata(i, 2) 
    End If
  Next i

  ' Écrire les résultats en une seule opération
  ws2.Range("S3:S" & lastRowmst + 2).Value = resultat_S

  MsgBox "Mise à jour terminée !", vbInformation

End Sub

Après ça m'étonne un peu que ce soit si long, après tout vous ne faites pas beaucoup d'opérations il me semble…

Si vous voulez une aide plus précise, sur des formules ou du PowerQuery, merci de joindre un fichier.

Rechercher des sujets similaires à "lenteur vba calcul ram"