Optimisation de calcul par VBA

[Mathcr]

Bonjour à tous,


Voila mon problème :

J'ai deux fichier avec 150K lignes. Je veux comparer la valeur de chaque référence entre les deux fichiers.

J'ai construit le fichier avec des recherchesv et somme.si (dans le cas ou une référence serait en doublons). Les temps de calcul ne sont pas supportable et le fichier plante 2 fois sur 3.

Je me demandais si l'utilisation de VBA permettrait d'optimiser ces calculs ? Le problème est que je suis novice en matière de VBA.

Vous trouverez ci joint un exemple

Merci d'avance pour votre aide

Bonne journée à tous

 

[Papou-net]

Re : Optimisation de calcul par VBA

Bonsoir Mathcr, et bienvenue à toi,

Voici ton fichier équipé d'une macro.

Un clic sur le bouton mettra les données à jour, en supprimant les doublons.

Espérant avoir répondu.

Cordialement.

 

[denis]

Re : Optimisation de calcul par VBA

Hello

Si le code d'en haut fonctionne tant mieux mais à mon humble avis il sera EXTREMEMENT lent vu la taille de ton fichier (150k lignes?), et vu la manière de parcourir les cellules utilisée dedans
Je n'arrive pas à charger de pièce joine malheureusement, je ne sais pas si c'est moi ou l'interface du forum... mais je colle le code ici, copie-colle-le dans un nouveau module

Option Explicit
Option Base 1

'nécessite(Reférences=>Microsoft Scripting Runtime) pour les Dictionary

Sub copiage_unique()
Dim source1_tab As Variant
Dim source2_tab As Variant
Dim lastr1 As Long
Dim lastr2 As Long
'
'comptons le nombre de lignes
'attention au noms des feuilles
lastr1 = Sheets("Source1").UsedRange.Rows.Count 'attention à ne pas avoir de lignes vides
lastr2 = Sheets("Source2").UsedRange.Rows.Count

'remplir les tables en mémoire
'ajuster les cellues au besoin
'je suppose que les tables s'arretent à la colonne d
source1_tab = Sheets("Source1").Range("a2:d" & lastr1).Value
source2_tab = Sheets("Source2").Range("a2:d" & lastr2).Value

Dim i As Long

'créer une liste de clés uniques
Dim cles As Dictionary
Set cles = New Dictionary

Dim source1_dico As Dictionary
Dim source2_dico As Dictionary
Set source1_dico = New Dictionary
Set source2_dico = New Dictionary
'attention, ici y a pas de vérification si les tables des deux sources contiennent
'des clés uniques ou non. Uniquement la table finale contiendra les clés uniques.
'si une clés en double est rencontrée dans une table source, elle sera ignorée
    For i = 1 To UBound(source1_tab)
    'supposons que le Prix se trouve dans la colonne d
    'donc la 4ième dans notre table
    If Not source1_dico.Exists(source1_tab(i, 1)) Then source1_dico.Add source1_tab(i, 1), source1_tab(i, 4)
    If Not cles.Exists(source1_tab(i, 1)) Then cles.Add source1_tab(i, 1), ""
    Next i
    
    For i = 1 To UBound(source2_tab)
    If Not source2_dico.Exists(source2_tab(i, 1)) Then source2_dico.Add source2_tab(i, 1), source2_tab(i, 4)
    If Not cles.Exists(source2_tab(i, 1)) Then cles.Add source2_tab(i, 1), ""
    Next i

Dim item As Variant
'pour chaque clé unique, calculer l'écart des deux sources
Dim temp As Double
Dim ecarts As Variant
'1 to 4 car 4 colonnes finales: clé, source1, source2, ecart.
ReDim ecarts(1 To cles.Count, 1 To 4)
i = 1
For Each item In cles.Keys
    ecarts(i, 1) = CStr(item)
    ecarts(i, 2) = CDbl(source1_dico(item))
    ecarts(i, 3) = CDbl(source2_dico(item))
    ecarts(i, 4) = ecarts(i, 3) - ecarts(i, 2)
i = i + 1
Next item
'mettre les résultats dans la feuille de synthese
Sheets("Synthese").Range("a2").Resize(UBound(ecarts, 1), UBound(ecarts, 2)).Value = ecarts
End Sub