VBA optimisation code comparaison de données

Bonjour à tous !

J'ai un petit problème pour optimiser une macro :

Je voudrais croiser les données de la Feuil1 avec celles de la Feuil2 :

Sur la feuil1 en face de chaque référence je souhaiterai sommer dans la colonne suivante les quantités de la Feuil2 de ces références

Ma macro fonctionne, mais sur mon fichier complet j'ai trop de données du coup l'exécution plante...

Je précise que je souhaite faire ce travail par macro car la volumétrie des données à croiser est trop importante pour être faite par formule.

Merci de votre aide !

Bonsoir,

Il faut faire un TCD comme dans le Feuil4. Le TCD est fait ça.

Bonsoir Raja,

La solution par TCD ne me convient pas car les données ne sont pas toutes croisées avec le même prisme, de plus les macros me permettent d'afficher des messages d'alertes lorsque mes bases ne sont pas cohérentes.

Merci,

Bonjour,

Essaie ainsi :

Public Sub DEMO()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim tbl As Variant, v As Variant
Dim Dict As Object
Dim i As Long

    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Feuil1")
    Set ws2 = wb.Worksheets("Feuil2")
    Set Dict = CreateObject("Scripting.Dictionary")

    Application.ScreenUpdating = False

    tbl = ws2.Cells(3, 1).CurrentRegion.Value
    For i = 2 To UBound(tbl)
        If Dict.exists(tbl(i, 1)) Then
            Dict(tbl(i, 1)) = Dict(tbl(i, 1)) + tbl(i, 3)
        Else
            Dict.Add tbl(i, 1), tbl(i, 3)
        End If
    Next i

    tbl = ws.Cells(1).CurrentRegion.Value
    For i = 2 To UBound(tbl)
        For Each v In Dict.keys
            If tbl(i, 1) = v Then
                tbl(i, 3) = Dict.Item(v)
                Exit For
            End If
        Next v
    Next i
    ws.Cells(1).CurrentRegion.Value = tbl

    Set Dict = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing

End Sub

Kan3pz a écrit :

Bonsoir Raja,

La solution par TCD ne me convient pas car les données ne sont pas toutes croisées avec le même prisme, de plus les macros me permettent d'afficher des messages d'alertes lorsque mes bases ne sont pas cohérentes.

Merci,

bonjour

avec un TCD, en cas de problème venant des tables de données, tu peux corriger en 30 secondes

avec VBA, il te faudra des jours

Bonjour à tous,

Ceci devrait suffire :

Public Sub DEMO()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim tbl As Variant
Dim Dict As Object
Dim i As Long
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("Feuil1")
    Set ws2 = wb.Worksheets("Feuil2")
    Set Dict = CreateObject("Scripting.Dictionary")
    Dict.Comparemode = 1
    Application.ScreenUpdating = False
    tbl = ws2.Cells(3, 1).CurrentRegion.Value
    For i = 2 To UBound(tbl, 1)
        Dict.Item(tbl(i, 1)) = Dict.Item(tbl(i, 1)) + tbl(i, 3)
    Next i
    tbl = ws.Cells(1).CurrentRegion.Value
    For i = 2 To UBound(tbl, 1)
        If Dict.exists(tbl(i, 1)) Then
            tbl(i, 3) = Dict.Item(tbl(i, 1))
        End If
    Next i
    ws.Cells(1).CurrentRegion.Value = tbl
    Set Dict = Nothing
    Set ws2 = Nothing: Set ws = Nothing
    Set wb = Nothing
End Sub

klin89

Re,

Bonjour klin89,

Ca veut dire que ma proposition n'est pas optimisée ?

Moi et l'objet Dictionary, c'est comme tulipe_4 et les TCDs.

Mais moi, je fais un effort.

Cdlt.

Bonjour à tous,

Merci beaucoup pour votre aide ça marche impec' il ne reste plus qu'à adapter la macro à mon fichier !