Comparer deux listes avec conditions

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous je suis nouvelle parmi vous!
J'ai quelques notions sur vba à travers ce que j'ai appris sur le net, mais là je bloque :(
Au fait, J'ai besoin d'un programme pour la comparaison du changement des prix de revient des articles acquis.J'ai deux feuille sur un classeur excel, une base standardisée, et la 2ème où je met les articles dernièrement acquis.
Dans chacune on a les infos suivante
Je veux parcourir les lignes de la feuille "data" (où je saisi les nouveaux articles) à partir du code article trouver le même article sur la 2eme feuille avec les données standardisées. Si le prix de revient est le même renvoyer "stable" dans la dernière colonne de l'article. Sinon comparer les 2 paramètres (prix d'achat et douane) et renvoyer en commentaire sur la dernière colonne le nom du paramètre qui change.

Dans la capture jointe vous verrez à quoi ressemble la première ligne organisant les 2 feuilles

J'ai essayé ce code mais ça me renvoie des erreurs.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 Sub tester() Dim X As Integer, i As Integer, j As Integer, c As Range Dim TD As String Dim PA As String Dim code As Long X = Application.WorksheetFunction.CountA(Range("A:A")) For i = 2 To X code = Sheets("DATA").Cells(i, 1).Value Set c = Sheets("BASE").Columns(1).Find(code, LookIn = xlValues).Row If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value = Sheets("DATA").Cells(i, 6).Value Then Sheets("DATA").Cells(i, 7).Value = "stable" Else If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value <> Sheets("DATA").Cells(i, 6).Value Then If Sheets("BASE").Cells(c, 4).Value <> Sheets("DATA").Cells(i, 4).Value Then TD = " Taux de douane different " Else TD = " " If Sheets("BASE").Cells(c, 5).Value <> Sheets("DATA").Cells(i, 5).Value Then PA = " Prix d'achat different " Else TD = " " Sheets("DATA").Cells(i, 7) = TD & PA End If Next i End Sub
Pièce jointe 365201

Bonjour,

Il te manque les END IF
Je les ai ajouté sans analyser le code plus que cela

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub tester()
 
Dim X As Integer, i As Integer, j As Integer, c As Range
Dim TD As String
Dim PA As String
Dim code As Long
 
X = Application.WorksheetFunction.CountA(Range("A:A"))
 
For i = 2 To X
    code = Sheets("DATA").Cells(i, 1).Value
     Set c = Sheets("BASE").Columns(1).Find(code, LookIn = xlValues).Row
 
        If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value = Sheets("DATA").Cells(i, 6).Value Then
            Sheets("DATA").Cells(i, 7).Value = "stable"
        Else
            If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value <> Sheets("DATA").Cells(i, 6).Value Then
                If Sheets("BASE").Cells(c, 4).Value <> Sheets("DATA").Cells(i, 4).Value Then
                    TD = " Taux de douane different "
                Else
                    TD = " "
                End If
                If Sheets("BASE").Cells(c, 5).Value <> Sheets("DATA").Cells(i, 5).Value Then
                    PA = " Prix d'achat different "
                Else
                    TD = " "
                End If
                Sheets("DATA").Cells(i, 7) = TD & PA
            End If
        End If
Next i
 
End Sub

Après une rapide analyse, voici le nouveau code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub tester()
 
Dim X As Integer, i As Integer, j As Integer, c1 As Range, c As Long
Dim TD As String
Dim PA As String
Dim code As Long
 
X = Application.WorksheetFunction.CountA(Range("A:A"))
 
For i = 2 To X
    code = Sheets("DATA").Cells(i, 1).Value
     Set c1 = Sheets("BASE").Columns(1).Find(code, LookIn:=xlValues)
     c = c1.Row
 
        If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value = Sheets("DATA").Cells(i, 6).Value Then
            Sheets("DATA").Cells(i, 7).Value = "stable"
        Else
            If Sheets("BASE").Cells(c, 1).Value = Sheets("DATA").Cells(i, 1).Value & Sheets("BASE").Cells(c, 6).Value <> Sheets("DATA").Cells(i, 6).Value Then
                If Sheets("BASE").Cells(c, 4).Value <> Sheets("DATA").Cells(i, 4).Value Then
                    TD = " Taux de douane different "
                Else
                    TD = " "
                End If
                If Sheets("BASE").Cells(c, 5).Value <> Sheets("DATA").Cells(i, 5).Value Then
                    PA = " Prix d'achat different "
                Else
                    TD = " "
                End If
                Sheets("DATA").Cells(i, 7) = TD & PA
            End If
        End If
Next i
 
End Sub

Merci de votre aide!
j'ai rectifié mon code, et après des rectifications ça me retourne une erreur du type "objet requis sur la ligne 19

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub tester()
 
Dim lastrow As Integer, i As Integer
Dim cr As Range
Dim cr1 As Long
Dim TD As String, PA As String
Dim CA As Variant
Dim B As Worksheet
Dim D As Worksheet
 
Application.ScreenUpdating = False
 
Set B = Worksheets("BASE")
Set D = Worksheets("DATA")
 
lastrow = D.Range("A1").End(xlDown).Row
For i = 2 To lastrow
    CA = D.Cells(i, 1).Value
    Set cr1 = B.Range("A:A").Find(CA, LookIn:=xlValues)
    cr = cr1.Row
 
        If B.Cells(cr, 1).Value = D.Cells(i, 1).Value & B.Cells(cr, 6).Value = D.Cells(i, 6).Value Then
        D.Cells(i, 7).Value = "stable"
        Else
        If B.Cells(cr, 1).Value = D.Cells(i, 1).Value & B.Cells(cr, 6).Value <> D.Cells(i, 6).Value Then
            If B.Cells(cr, 4).Value <> D.Cells(i, 4).Value Then
            TD = " Taux de douane different "
            Else
            TD = " "
            End If
        D.Cells(i, 7) = TD & PA
        End If
    End If
 
Next i
 
End Sub

29/03/2018, 10h26
Bob78280
Bonjour,

C'est normal, il faut inverser cela :
Code:

1 2 3 Dim cr As Range Dim cr1 As Long
pour que cela donne ceci
Code:

1 2 3 Dim cr1 As Range Dim cr As Long
29/03/2018, 11h02
Fayrouzam

ça marche à merveille :D
Merciiiii !

erreur

Bonjour, en executant la macro aujoud'hui celle ci me retourne une erreur du type "object variable ou bloc with non défini" sur le cr=cr1.row
help please!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub Comparer_pru()
 
Dim lastrow As Integer, i As Integer
Dim cr1 As Range
Dim cr As Long
Dim TD As String, PA As String, PL As String
Dim CodeAcomparer As Variant
Dim B As Worksheet
Dim D As Worksheet
 
Application.ScreenUpdating = False
 
Set B = Worksheets("BASE")
Set D = Worksheets("DATA")
 
lastrow = D.Range("D1").End(xlDown).Row
 
    For i = 2 To lastrow
        CodeAcomparer = D.Cells(i, 4).Value
        Set cr1 = B.Range("G:G").Find(CodeAcomparer, LookIn:=xlValues)
        cr = cr1.Row
            If B.Cells(cr, 7).Value = D.Cells(i, 4).Value And B.Cells(cr, 44).Value = D.Cells(i, 26).Value Then
                D.Cells(i, 27).Value = "stable"
            ElseIf B.Cells(cr, 7).Value = D.Cells(i, 4).Value And B.Cells(cr, 44).Value <> D.Cells(i, 26).Value Then
                    If B.Cells(cr, 22).Value <> D.Cells(i, 16).Value Then
                        TD = " Taux de douane différent "
                    Else
                        TD = " "
                    End If
                    If B.Cells(cr, 11).Value <> D.Cells(i, 8).Value Then
                        PA = " Prix d'achat différent "
                    Else
                        PA = " "
                    End If
                    If B.Cells(cr, 15).Value <> D.Cells(i, 11).Value Then
                        PL = " Préstation logistique différente "
                    Else
                        PL = " "
                    End If
                D.Cells(i, 27) = TD & PA & PL
                End If
 
    Next i
End Sub

Bonjour,

Je suppose fortement que la valeur cherchée n'existe pas dans l'onglet BASE.
Il faudrait ajouter quelque chose du style :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
        Set cr1 = B.Range("G:G").Find(CodeAcomparer, LookIn:=xlValues)
        If cr1 Is Nothing Then
            ' faut-il faire quelques chose si la valeur n'existe pas?
        Else
            cr = cr1.Row
            If B.Cells(cr, 7).Value = D.Cells(i, 4).Value And B.Cells(cr, 44).Value = D.Cells(i, 26).Value Then
                D.Cells(i, 27).Value = "stable"
            ElseIf B.Cells(cr, 7).Value = D.Cells(i, 4).Value And B.Cells(cr, 44).Value <> D.Cells(i, 26).Value Then
                If B.Cells(cr, 22).Value <> D.Cells(i, 16).Value Then
                    TD = " Taux de douane différent "
                Else
                    TD = " "
                End If
                If B.Cells(cr, 11).Value <> D.Cells(i, 8).Value Then
                    PA = " Prix d'achat différent "
                Else
                    PA = " "
                End If
                If B.Cells(cr, 15).Value <> D.Cells(i, 11).Value Then
                    PL = " Préstation logistique différente "
                Else
                    PL = " "
                End If
                    D.Cells(i, 27) = TD & PA & PL
            End If
        End If

04/04/2018, 16h12
Fayrouzam

Merci infiniment.