Comment comparer deux listes d'inventaire?

[n.perez]

Bonjour,

Comme chaque fin d'année nous faisons l'inventaire de notre atelier,

Aussi j'aimerais pouvoir comparer le stock avant inventaire et après inventaire.
Ce qui correspond aux feuille 1 et 2 sur mon tableaux Excel extraites d'un logiciel de gestion,
En parcourant le forum je n'ai pas trouvé exactement ce que je voullais,

Il s'agit en fait de comparer le stock "collone C" en fonction du code "collone A",
Ce qui est plus complexe c'est que la collone A n'est pas identique dans les deux feuilles,

L'idéal serait de mettre en évidance:
1-les différences de stock sur les codes présents dans les deux feuilles,
2-les codes présents sur la feuille 1 et qui ont disparus de la feuille 2,

Peut être avez vous une solution?

Merci d'avance,

Bien cordialement,

Nicolas

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

Bonjour.

Vous pouvez déjà mettre en D2:

=$C2-INDEX('stock  avant inv.'!$C2:$C$1570;EQUIV($A2;'stock avant  inv.'!$A2:$A$1570;0))

Propagé vers le bas.

 

[n.perez]

Re : Comment comparer deux listes d'inventaire?

Bonjour,
Merci pour votre réponse,

Celà ne semble pas fonctionner,
Une fenêtre s'ouvre (mettre à jour les valeurs : stock avant inv.)
Et les cellules apparaissent #n/a

 

[BOISGONTIER]

Re : Comment comparer deux listes d'inventaire?

Bonjour,

cf PJ

Sub CompareBD()
    Application.ScreenUpdating = False
    't = Timer()
    Set f1 = Sheets("BD1")
    Set f2 = Sheets("BD2")
    Set f3 = Sheets("ecart")
    ligne = 1
    n1 = f1.Range("A65000").End(xlUp).Row
    n2 = f2.Range("A65000").End(xlUp).Row
    a = f1.Range("A2:C" & n1).Value
    b = f2.Range("A2:C" & n2).Value
    Set mondico1 = CreateObject("Scripting.Dictionary")
    For I = 1 To n1 - 1: mondico1.Add a(I, 1), I: Next
    Set mondico2 = CreateObject("Scripting.Dictionary")
    For I = 1 To n2 - 1: mondico2.Add b(I, 1), I: Next
    Dim c()
    n = n1 + n2
    ReDim c(1 To n, 1 To 6)
    [A2:L30000].ClearContents
    '--- communs
    For I = 1 To n1 - 1
      temp = a(I, 1)
      If mondico2.Exists(temp) Then
        p = mondico2.Item(temp)
        For K = 1 To 3: c(ligne, K) = a(I, K): Next K
        c(ligne, 4) = b(p, 3)
        c(ligne, 5) = b(p, 3) - a(I, 3)
        c(ligne, 6) = "Communs"
        ligne = ligne + 1
      End If
    Next I
    '--- BD2-BD1
    For I = 1 To n2 - 1
      temp = b(I, 1)
      If Not mondico1.Exists(temp) Then
        p = mondico2.Item(temp)
        For K = 1 To 3: c(ligne, K) = b(I, K): Next K
        c(ligne, 5) = b(p, 3)
        c(ligne, 6) = f2.Name
        ligne = ligne + 1
      End If
    Next I
    '---  BD1-BD2
    For I = 1 To n1 - 1
      temp = a(I, 1)
      If Not mondico2.Exists(temp) Then
        p = mondico1.Item(temp)
        For K = 1 To 3
          c(ligne, K) = a(I, K)
        Next K
        c(ligne, 5) = -a(p, 3)
        c(ligne, 6) = f1.Name
        ligne = ligne + 1
      End If
    Next I
    f3.[a2].Resize(ligne, 6) = c
    'MsgBox Timer() - t
End Sub

Sub BD1_BD2()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BD2")
  Set f2 = Sheets("BD1")
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For I = 2 To UBound(a)
     mondico1(a(I, 1)) = ""
  Next I
  ligne = 1
  Dim c
  ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
  For I = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(I, K): Next K
    If Not mondico1.Exists(b(I, 1)) Then
       For K = 1 To UBound(b, 2): c(ligne, K) = b(I, K): Next K
       c(ligne, K) = I
       ligne = ligne + 1
    End If
  Next
  Sheets("BD1 NON BD2").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c
End Sub
Sub BD2_BD1()
  Application.ScreenUpdating = False
  Set f1 = Sheets("BD1")
  Set f2 = Sheets("BD2")
  a = f1.Range("A1").CurrentRegion.Value
  b = f2.Range("A1").CurrentRegion.Value
  Set mondico1 = CreateObject("Scripting.Dictionary")
  For I = 2 To UBound(a)
     mondico1(a(I, 1)) = ""
  Next I
  ligne = 1
  Dim c
  ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
  For I = 2 To UBound(b)
    temp = ""
    For K = 1 To UBound(b, 2): temp = temp & b(I, K): Next K
    If Not mondico1.Exists(b(I, 1)) Then
       For K = 1 To UBound(b, 2): c(ligne, K) = b(I, K): Next K
       c(ligne, K) = I
       ligne = ligne + 1
    End If
  Next
  Sheets("BD2 NON BD1").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c
End Sub

JB

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

J'ai oublié un dollar
En 'stock avant inv.'!D2 :

=$C2-INDEX('stock après inv.'!$C$2:$C$1570,MATCH($A2,'stock après inv.'!$A$2:$A$1570,0))

En 'stock après inv.'!D2 :

=$C2-INDEX('stock avant inv.'!$C2:$C$1570,MATCH($A2,'stock avant inv.'!$A2:$A$1570,0))

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

Sinon on peut aussi le faire comme ça.

 

[n.perez]

Re : Comment comparer deux listes d'inventaire?

Bonjour,
Merci pour votre réponse qui me parait très bien,

Simplement est-ce possible de metre la différence en numérique et non en pourcentage (type +2 -4 ect..)

Merci d'avance,

Bien cordialement

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

Bonjour.
Elles y sont d'abord toujours les différences. Le % c'est juste pour mettre quelque chose aussi dans les observations si ce n'est ni un nouveau ni un disparu. Alors je mets ce que représente la différence déjà indiquée par rapport à la quantité initiale. Si ça ne vous intéresse pas il suffit de mettre "" au lieu de Diff / IIf(QtéI <> 0, QtéI, 1) dans la macro.

 

[n.perez]

Re : Comment comparer deux listes d'inventaire?

Oui pardon,

Je l'ai remarqué après,

C'est ce qu'il me fallait,

Merci beaucoup

 

[klin89]

Re : Comment comparer deux listes d'inventaire?

Bonsoir le forum,

Une autre manière de procéder, résultat en Feuil3 :
Peut ne pas fonctionner sur certains PC.

Option Explicit
Sub Comparer()
Dim a, i As Long, n As Long, AL As Object, e, txt As String, x As Object
    Application.ScreenUpdating = False
    Set AL = CreateObject("System.Collections.ArrayList")
    With CreateObject("System.Collections.SortedList")
        For Each e In Array("stock avant inv.", "stock après inv.")
            a = Sheets(e).Cells(1).CurrentRegion.Resize(, 3).Value
            If e = "stock avant inv." Then a(1, 3) = "Stock Avant" Else a(1, 3) = "Stock Après"
            For i = 1 To UBound(a, 2)
                If Not AL.Contains(a(1, i)) Then AL.Add a(1, i)
            Next
            For i = 2 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .Contains(txt) Then
                    ReDim w(1 To AL.Count)
                    w(1) = a(i, 1): w(2) = a(i, 2)
                    w(AL.IndexOf(a(1, 3), 0) + 1) = w(AL.IndexOf(a(1, 3), 0) + 1) + a(i, 3)
                    .Item(txt) = w
                Else
                    w = .Item(txt)
                    ReDim Preserve w(1 To AL.Count)
                    w(AL.IndexOf(a(1, 3), 0) + 1) = w(AL.IndexOf(a(1, 3), 0) + 1) + a(i, 3)
                    .Item(txt) = w
                End If
            Next
        Next
        Set x = .Clone
    End With
    With Sheets("Feuil3").Cells(1).Resize(, AL.Count)
        .CurrentRegion.Clear
        .Value = AL.ToArray
        For i = 0 To x.Count - 1
            .Cells(i + 2, 1).Resize(, UBound(x.GetByIndex(i))).Value = x.GetByIndex(i)
        Next
        With .CurrentRegion
            On Error Resume Next
            .Offset(, 2).Resize(, .Columns.Count - 2).SpecialCells(4).Value = 0
            On Error GoTo 0
            .Offset(, .Columns.Count).Resize(1, 1) = "Ecart"
            '            With .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1)
            '                .Formula = "=rc[-2]-rc[-1]"
            '            End With
            n = .Rows.Count - 1
            With .Offset(1, .Columns.Count).Resize(1, 1)
                .Formula = [{"=C2-D2"}]
                If n > 1 Then .AutoFill .Resize(n)
            End With
        End With
        With .CurrentRegion
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .Resize(, 2).Interior.ColorIndex = 46
                .Offset(, 2).Resize(, 2).Interior.ColorIndex = 45
                .Offset(, 4).Resize(, 1).Interior.ColorIndex = 6
                .BorderAround ColorIndex:=1, Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
        .Parent.Select
    End With
    Application.ScreenUpdating = True
End Sub

Des valeurs négatives figurent sur tes 2 feuilles.
Pour le calcul des écarts dans la dernière colonne, j'ai un doute sur la formule utilisée.

klin89

 

[klin89]

Re : Comment comparer deux listes d'inventaire?

Bonsoir le forum et Bon Noël à tous

Un petit correctif :

Option Explicit
Sub Comparer()
Dim a, i As Long, n As Long, AL As Object, e, txt As String, x As Object
    Application.ScreenUpdating = False
    Set AL = CreateObject("System.Collections.ArrayList")
    With CreateObject("System.Collections.SortedList")
        For Each e In Array("stock avant inv.", "stock après inv.")
            a = Sheets(e).Cells(1).CurrentRegion.Resize(, 3).Value
            If e = "stock avant inv." Then a(1, 3) = "Stock Avant" Else a(1, 3) = "Stock Après"
            For i = 1 To UBound(a, 2)
                If Not AL.Contains(a(1, i)) Then AL.Add a(1, i)
            Next
            For i = 2 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .Contains(txt) Then
                    ReDim w(1 To AL.Count)
                    w(1) = a(i, 1): w(2) = a(i, 2)
                    w(AL.IndexOf(a(1, 3), 0) + 1) = w(AL.IndexOf(a(1, 3), 0) + 1) + a(i, 3)
                    .Item(txt) = w
                Else
                    w = .Item(txt)
                    ReDim Preserve w(1 To AL.Count)
                    w(AL.IndexOf(a(1, 3), 0) + 1) = w(AL.IndexOf(a(1, 3), 0) + 1) + a(i, 3)
                    .Item(txt) = w
                End If
            Next
        Next
        Set x = .Clone
    End With
    With Sheets("Ecarts").Cells(1).Resize(, AL.Count)
        .CurrentRegion.Clear
        .Value = AL.ToArray
        For i = 0 To x.Count - 1
            .Cells(i + 2, 1).Resize(, UBound(x.GetByIndex(i))).Value = x.GetByIndex(i)
        Next
        With .CurrentRegion
            On Error Resume Next
            .Offset(, 2).Resize(, .Columns.Count - 2).SpecialCells(4).Value = 0
            On Error GoTo 0
            .Offset(, .Columns.Count).Resize(1, 1) = "Ecarts"
            '            With .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1)
            '                .Formula = "=rc[-1]-rc[-2]"
            '            End With
            n = .Rows.Count - 1
            With .Offset(1, .Columns.Count).Resize(1, 1)
                .Formula = [{"=D2-C2"}]
                If n > 1 Then .AutoFill .Resize(n)
            End With
            .Offset(1, .Columns.Count).Resize(.Rows.Count - 1, 1).NumberFormat = "+0;-0;0;"
        End With
        With .CurrentRegion
            .BorderAround ColorIndex:=1, Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            With .Rows(1)
                .Resize(, 2).Interior.ColorIndex = 46
                .Offset(, 2).Resize(, 2).Interior.ColorIndex = 45
                .Offset(, 4).Resize(, 1).Interior.ColorIndex = 6
                .BorderAround ColorIndex:=1, Weight:=xlThin
            End With
            .Columns(1).Resize(, 2).AutoFit
            .Columns(3).Resize(, 3).ColumnWidth = 11
        End With
        .Parent.Select
    End With
    Application.ScreenUpdating = True
End Sub

Dranreb, je ne vois pas les écarts 0 apparaitre dans ta solution.
Exemple :

Code article                Intitulé 1            Stock Avant  Stock Après  Ecarts
     193            RACLEUR PLAT-POUR ELECTRO          1            1         0

klin89

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

je ne vois pas les écarts 0 apparaitre dans ta solution.

de N.perez:

L'idéal serait de mettre en évidance:
1-les différences …

alors quand il n'y en a pas, ça n'apparait pas, c'est fait exprès.

 

[n.perez]

Re : Comment comparer deux listes d'inventaire?

Bonjour,

Et Meilleurs voeux à tous pour cette année 2015,

La dernière solution est parfaite,

Je vous en remercie,

Aussi j'ai volontairement effacé les prix associés aux lignes d'article pour un soucis de "confidentialité" dans la sociét pour laquelle je travaille,

En fait dans le même tableau j'ai dans la collone D le pris de l'article et dans la collone E le montant que cela représente en fonction des quantités,

Serait il possible de reporter également l'écart en terme de valeur?

Vous en remerciant d'avance,

bien cordialement,

Nicolas PEREZ

 

[Dranreb]

Re : Comment comparer deux listes d'inventaire?

Bonjour.

Essayez comme ça :

Option Explicit

Private Sub Worksheet_Activate()
Dim Dsgn As SsGroup, Code As SsGroup, MntI As Currency, QtéI As Double, Diff As Double, _
   DfMt As Currency, Ts(1 To 60000, 1 To 6), Cas As Byte, Détail, L&
For Each Dsgn In GroupOrg(TableUnique(PlgUti(FAvInv.[A2]), PlgUti(FApInv.[A2])), 2, 1)
   For Each Code In Dsgn.Contenu
      Diff = 0: QtéI = 0: DfMt = 0: Cas = 0
      For Each Détail In Code.Contenu
         If Détail(0) = 0 Then
            QtéI = Détail(3)
            Diff = Diff - QtéI
            DfMt = DfMt - Détail(5)
            Cas = 1
         Else
            Diff = Diff + Détail(3)
            DfMt = DfMt + Détail(5)
            Cas = Cas + 2: End If
         Next Détail
      If Diff <> 0 Then ' parce que seules les lignes présentant une différence de quantité sont souhaitées, c'est bien ça ?
         L = L + 1
         Ts(L, 1) = Code.Id
         Ts(L, 2) = Dsgn.Id
         Ts(L, 3) = Diff
         If Diff <> 0 Then Ts(L, 4) = DfMt / Diff
         Ts(L, 5) = DfMt
         Ts(L, 6) = Choose(Cas, "Disparu", "Nouveau", Diff / IIf(QtéI <> 0, QtéI, 1)): End If
      Next Code, Dsgn
Me.[A2:D60000].ClearContents
Me.[A2].Resize(L, 6).Value2 = Ts
Cells.Columns.AutoFit
End Sub