Comparer deux listes avec conditions

**Fayrouzam** · 28/03/2018, 11h25

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Nom : Capture.PNG
Affichages : 164
Taille : 2,8 Ko

**Bob78280** · 28/03/2018, 16h10

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Bob78280** · 28/03/2018, 16h20

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Fayrouzam** · 29/03/2018, 11h15

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Bob78280** · 29/03/2018, 11h26

Bonjour,

C'est normal, il faut inverser cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Dim cr As Range
Dim cr1 As Long

pour que cela donne ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Dim cr1 As Range
Dim cr As Long

**Fayrouzam** · 29/03/2018, 12h02

ça marche à merveille

Merciiiii !

**Fayrouzam** · 03/04/2018, 12h15

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Bob78280** · 03/04/2018, 15h18

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Fayrouzam** · 04/04/2018, 17h12

Merci infiniment.

Comparer deux listes avec conditions

Macros et VBA Excel

Discussions similaires

Partager

Partager