Optimisation de calcul par VBA

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