Solution pour identifier baisses ou hausses prix

Bonjour,

J'essaye depuis un moment de trouver une solution pour me simplifier la vie lorsque je reçois des nouveaux plans d'achats. Je m'explique.

Mes fournisseurs m'envoient régulièrement leur nouveau plan d'achat sous format excell. comme suit

Référence - Nouveauté - remise - Tarifs de base - remise dynamique - prix net facturé - ecotaxe (ce qui nous interesse étant Référence et prix net facturé)

Or j'aimerai connaitre une solution qui me permettrai de pouvoir connaitre quels sont les produits qui ont subit des hausses/baisses entre les deux plans d achats. ce qui me permettrait un gain de temps énorme, dans la mesure où actuellement je fais ca à l'ancienne :

j'imprime les deux plans d'achats, anciens et nouveaux et je coche et rectifie les produits par la suite sur mon site...

Merci d'avance aux experts excell

Salut Nanee

Est-ce-que tu est intéressé par cette proposition

A première vue c'est génial !

est il possible de rajouter une commande permettant d identifier un produit qui ne se fait plus, qui aurait été supprimer entre les deux bases ?

et un produit aurait été ajouté (type nouveauté)

Merci en tout cas de ta part

Bonjour,

apparemment cette solution ne marche plus, puisque lorsqu'il ny a plus de de hausse ou baisse la macro ne fait pas la différence. est il possible de rajouter une commande pour les produits qui sont nouveaux et qui serait mis en surbrillance ou à l'écart ?

Merci à vous

De plus lorsqu'il y a une hausse , il me dit baisse et inversement.

Bonsoir Nanee,

Vois ceci :

Option Explicit
Sub test()
    Dim a, w(), e, i As Long, t As Byte, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1: t = 0
    For Each e In Array("Ancien plans", "Nouveau plans")
        a = Sheets(e).Cells(1).CurrentRegion.Value2
        For i = 9 To UBound(a, 1)
            If Not dico.exists(a(i, 1)) Then
                ReDim w(1 To 6)
            Else
                w = dico(a(i, 1))
            End If
            w(1 + t) = a(i, 1): w(2 + t) = a(i, 14)
            dico(a(i, 1)) = w
        Next
        t = t + 2
    Next
    For Each e In dico.keys
        w = dico(e)
        w(5) = w(2) - w(4)
        Select Case w(5)
        Case Is > 0
            w(6) = "p"
        Case Is < 0
            w(6) = "q"
        Case Is = 0
            w(6) = "tu"
        End Select
        dico(e) = w
    Next
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Restitution").Delete
    Sheets.Add().Name = "Restitution"
    On Error GoTo 0
    With Sheets("Restitution").Cells(1)
        .Resize(, 6) = Array("Référence", "Ancien prix", "Référence", "Nouveaux prix", "Différence", "Evolution")
        .Offset(1).Resize(dico.Count, 6).Value = Application.Index(dico.items, 0, 0)
        With .CurrentRegion
            .VerticalAlignment = xlCenter
            .Font.Name = "calibri"
            .Font.Size = 10
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Columns(6)
                .HorizontalAlignment = xlCenter
                .Offset(1).Font.Name = "Wingdings 3"
            End With
            With .Rows(1)
                .Interior.ColorIndex = 43
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Font.Size = 11
            End With
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
    Set dico = Nothing
End Sub

klin89