Excel 2003 alignement et comparaison de 2 colonnes

Le 13/05/2015 à 09:41

Bonjour,

Voici, mon problème dans excel. J'ai deux fichiers : 2013 et 2014 contenant des libellés de produits, les prix HT et la quantité acheté. Je souhaiterai comparer les prix 2014 à ceux de 2013.

Je souhaiterai donc aligner par correspondance les deux colonnes 2014 et 2013 des libellés de produits, sachant que certains libellés sont communs et d'autre sont en plus, en gardant la correspondance des prix 2014 et 2013 avec leurs libellés respectif.

Exemple:

2013

A B C

LIB 2013 PRIX 2013 QT 2013

paracétamol 1g 0.05 12

amoxicilline 500mg 0.5 20

piperacilline 1g 4 50

ac clavula 0.12 5

2014

A B C

LIB 2014 PRIX 2014 QT2014

amoxicilline 500mg 45 78

trihexylphen 4 50

ac clavula 14 58

paracétamol 1g 3 24

et je voudrais

A B C D E F

2013 LIBELL PRIX 2013 QT 2013 2014 LIB 2014PRIX 2014QT

paracétamol 1g 0.05 12 paracétamol 1g 3 24

amoxicilline 500mg 0.5 20 amoxicilline 500mg 45 78

piperacilline 1g 4 50

ac clavula 0.12 5 ac clavula 14 58

trihexylphen 4 50

Le 13/05/2015 à 10:02

Bonjour,

très bien, pas de soucis, il y a tout ce qu'il faut même ne pièces détachées ici ... avec un bout de fichier excel, car là il y a beaucoup de données à rentrer !

Le 13/05/2015 à 11:32

Bonjour,

Voici en pièce jointe mes deux fichiers 2013 et 2014.

En vous remerciant par avance

Le 13/05/2015 à 11:56

voici, les fichiers en pièces jointes

72013.zip (96.90 Ko)
102014.zip (94.18 Ko)
Le 13/05/2015 à 13:50

J'ai rassemblé dans un même fichier pour plus de facilité.

https://www.cjoint.com/c/EEnofdMMZIy

Le 13/05/2015 à 15:11

Dans l'onglet comparaison du nouveau fichier, il apparait uniquement "#NOM", est ce normal pour le moment ?

Le 13/05/2015 à 17:33

ah non pas du tout, pas chez moi !

est-ce lié à une différence de version ?

capture d ecran 15

je te renvoie en version 97

https://www.cjoint.com/c/EEnrVipnFII

Le 14/05/2015 à 18:09

Bonjour Steelson, SGA, le forum

Avec le code ci-dessous, je liste les libellés produits de tes 2 feuilles.

Tu pourras constater que certains libellés sont dupliqués (jusqu'à 8 fois pour un libellé) :

29 pour l'année 2013

20 pour l'année 2014

Certains libellés apparaissent avec le même code produit ou pas

Que fait-on dans ces cas là

Exemple

|PANSEMENT BIATAIN NON ADH 10 X 20 REF 33| |327243 0 384| |327243 1,29 384|

Option Explicit

Sub Regroupement()
Dim a, i As Long, j As Long, n As Long, col As Byte, w
    With Sheets("2014").Range("a1").CurrentRegion
    'With Sheets("2013").Range("a1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(2, 1, 3, 4))
    End With
    col = UBound(a, 2): n = 1: a(1, 1) = "Libellé produit"
    a(1, 2) = "Code produit1": a(1, 3) = "Prix unitaire1": a(1, 4) = "Qté livrée1"
    With CreateObject("Scripting.Dictionary")
        '.CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .Item(a(i, 1)) = VBA.Array(n, col)
                For j = 1 To col
                    a(n, j) = a(i, j)
                Next
            Else
                w = .Item(a(i, 1)): w(1) = w(1) + 3
                If UBound(a, 2) < w(1) Then
                    ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
                    a(1, w(1) - 2) = a(1, 2)
                    a(1, w(1) - 1) = a(1, 3)
                    a(1, w(1)) = a(1, 4)
                End If
                For j = 1 To 3
                    a(w(0), w(1) - 3 + j) = a(i, j + 1)
                Next
                .Item(a(i, 1)) = w
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.Clear
        .Value = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 43
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
        If UBound(a, 2) > 4 Then
            With .Offset(, 1).Resize(1, 3)
                .AutoFill .Resize(, UBound(a, 2) - 1)
            End With
        End If
        .Parent.Select
    End With
    Application.ScreenUpdating = True
End Sub

Conclusion : difficile de répondre à la question initiale

Question : pour déterminer un doublon, on doit donc s'appuyer sur même libellé, un même code produit et un même prix unitaire, n'est ce pas ?

klin89

15sga.zip (90.85 Ko)
Le 17/05/2015 à 22:41

Bonsoir Steelson, SGA, le forum

Tes 2 feuilles sources contenaient des libellés dupliqués, j'ai donc fusionné ces lignes via la macro ci-dessous pour créer 2 nouvelles feuilles à libellés uniques ----> voir feuilles "An2013" et "An2014"

Toutes tes données sont conservées.

Option Explicit

Sub Libellé_Produit()
Dim a, i As Long, j As Long, n As Long
    Application.ScreenUpdating = False
    'a = Sheets("2013").Cells(1).CurrentRegion.Resize(, 4).Value
    a = Sheets("2014").Cells(1).CurrentRegion.Resize(, 4).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 2)) Then
                n = n + 1: .Item(a(i, 2)) = n
                For j = 1 To UBound(a, 2)
                    a(n, j) = a(i, j)
                Next
            Else
                a(.Item(a(i, 2)), 1) = Join(Array(a(.Item(a(i, 2)), 1), a(i, 1)), vbLf)
                a(.Item(a(i, 2)), 3) = Join(Array(a(.Item(a(i, 2)), 3), a(i, 3)), vbLf)
                a(.Item(a(i, 2)), 4) = Join(Array(a(.Item(a(i, 2)), 4), a(i, 4)), vbLf)
            End If
        Next
    End With
    With Sheets.Add().Cells(1).Resize(n, UBound(a, 2))
        For i = 1 To n
            For j = 1 To UBound(a, 2)
                .Cells(i, j).Value = a(i, j)
            Next
        Next
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlTop
            .Borders(xlInsideVertical).Weight = xlThin
            .BorderAround Weight:=xlThin
            With .Rows(1)
                .Font.Size = 11
                .Interior.ColorIndex = 38
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
            .Rows.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Puis, en m'appuyant sur ces 2 feuilles, je lance la comparaison via cette autre macro :

Option Explicit

Sub Alignement()
Dim a, i As Long, j As Long, w, x, y
    With Sheets("An2013").Range("a1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(2, 3, 4))
    End With
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            ReDim w(1 To UBound(a, 2) * 2)
            For j = 1 To UBound(a, 2)
                w(j) = a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        With Sheets("An2014").Range("a1").CurrentRegion
            a = Application.Index(.Value, Evaluate("row(1:" & _
                                                   .Rows.Count & ")"), Array(2, 3, 4))
        End With
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                w = .Item(a(i, 1))
                For j = 1 To UBound(a, 2)
                    w(j + UBound(a, 2)) = a(i, j)
                Next
            Else
                ReDim w(1 To UBound(a, 2) * 2)
                For j = 1 To UBound(a, 2)
                    w(j + UBound(a, 2)) = a(i, j)
                Next
            End If
            .Item(a(i, 1)) = w
        Next
        x = .Count: y = .items
        Application.ScreenUpdating = False
        With Sheets("Comparaison").Cells(1)
            .CurrentRegion.Clear
            Sheets("An2013").Range("B1:D1").Copy .Range("A1").Resize(1, 3)
            Sheets("An2014").Range("B1:D1").Copy .Offset(, 3).Resize(1, 3)
            With .Offset(1).Resize(x, UBound(a, 2) * 2)
                .Value = Application.Transpose(Application.Transpose(y))
                With .CurrentRegion
                    .Font.Name = "calibri"
                    .Font.Size = 10
                    .VerticalAlignment = xlCenter
                    .Borders(xlInsideVertical).Weight = xlThin
                    .BorderAround Weight:=xlThin
                    With .Rows(1)
                        .Font.Size = 11
                        '.Interior.ColorIndex = 43
                        .BorderAround Weight:=xlThin
                    End With
                    .Columns.AutoFit
                End With
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Clique sur le bouton et vois le résultat en feuille "Comparaison".

Klin89

18sga1.zip (280.73 Ko)
Le 20/05/2015 à 09:52

bonjour,

Malheuresement le bouton "comparaison" ne fonctionne pas et la pgae " comparaison" est vierge, peut être est-ce un problème de version ? (je travaille sur Excel 2003...)

Merci

Le 21/05/2015 à 12:03

Bonjour,

Steelson, la version 97 fonctionne, mais serait-il possible ajouter deux colonnes au tableau : quantité 2013 et quantité 2014, j'ai essayer avec la fonction recherche V mais ça ne marche pas

Merci

wahouh !!! super ça marche Merci bcp de vous être penché sur mon problème (les boutons fonctionnent, ils suffisait de modifier le niveau de sécurité des macros)

Maintenant si vous avez la patiencen j'aimerai comprendre comment vous avez fait

Merci en tout cas !

Rechercher des sujets similaires à "2003 alignement comparaison colonnes"