Discussion :

[anais83]

Bonjour à tous,

Après pleins de test je vous écrit car je ne trouve pas la solution et que peut être je pourrais bénéficier de vos lumières. Vous trouverez ci joint mon fichier ainsi que le 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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
Dim u, v, I, j, dico1, dico2, lgn
 
Sub Synthèse()
 
   Dim Cel As Range
 
    Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).Interior.Color = xlNone
    Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Application.ScreenUpdating = False
 
    u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
    v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
 
    Set dico1 = CreateObject("Scripting.Dictionary")
    Set dico2 = CreateObject("Scripting.Dictionary")
 
    For I = 1 To UBound(u, 1)
        dico1(u(I, 11)) = I
    Next I
 
    For I = 1 To UBound(v, 1)
        dico2(v(I, 11)) = ""
    Next I
 
    For I = 1 To UBound(u, 1)
        'on recopie les ligns de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
        If dico2.exists(u(I, 11)) = False Then
            lgn = Sheets("Synthèse").Range("A" & Rows.Count).End(xlUp)(2).Row
            For j = 1 To UBound(u, 2)
                Sheets("Synthèse").Cells(lgn, j) = u(I, j)
            Next j
        End If
    Next I
 
    For I = 1 To UBound(v, 1)
        lgn = Sheets("Synthèse").Range("A" & Rows.Count).End(xlUp)(2).Row
        If dico1.exists(v(I, 11)) Then
 
            'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
            For j = 1 To UBound(v, 2)
                Sheets("Synthèse").Cells(lgn, j) = v(I, j)
                If u(I, j) <> v(I, j) Then
                    Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
                End If
            Next j
 
        Else
            'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
             For j = 1 To UBound(v, 2)
                Sheets("Synthèse").Cells(lgn, j) = v(I, j)
            Next j
 
        End If
          Next I
 
End Sub

La macro compare deux feuilles dans une feuille de synthèse :

-Copie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2

- Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes

-Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse

Mon problème concerne la partie où les écarts sont colorés sur la feuille de synthèse car elle compare les lignes une à une , or je souhaiterai que celle ci compare les lignes en fonction de l'ID en colonne "K" mais je ne trouve pas comment faire ....

Merci de m'avoir lu , à votre dispo pour tout renseignement complémentaire
!

Bonne journée

A.

[Tête de chat]

Si j'ai bien compris il faut modifier ça :

Code :

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

1
2
3
If u(I, j) <> v(I, j) Then
       Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If

et au lieu de tester la différence sur j tester toujours la colonne 9 (K)

Code :

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

1
2
3
If u(I, 9) <> v(I, 9) Then
       Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
End If

Tu pourrais sans doute sortir ça de la boucle et poser la couleur d'un coup sur toute la ligne, mais comme je n'ai tout suivi de ce ue tu fais, je préfère ne pas me lancer dans de la simplification...
Et puis il faudra voir comment mettre ce 9 dans une constante ou un paramètre, mettre un objet devant ce sheet qui est bien seul (référence implicite à ActiveWorkBook, ça peut mal finir), etc.

[EricDgn]

Bonjour,

Le problème vient de ce que les lignes ne sont pas toutes dans la même position dans chacune des feuilles et donc dans les tables u et v. Il faut donc aller rechercher à quels endroits se trouvent les ID identiques d'un côté et de l'autre. Une façon de faire:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Explicit
 
Sub Synthèse()
    Dim u, v, Cel As Range
    Dim dico1 As Object, dico2 As Object
    Dim i As Long, j As Long, lgn As Long
 
    Sheets("Synthèse").Select
    Range("A2:CF" & Rows.Count).Clear
    Application.ScreenUpdating = False
    u = Sheets("PDC").Range("A2:CF" & Sheets("PDC").Range("A" & Rows.Count).End(xlUp).Row)
    v = Sheets("PDC_en cours").Range("A2:CF" & Sheets("PDC_en cours").Range("A" & Rows.Count).End(xlUp).Row)
 
    Set dico1 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(u, 1)
        dico1(u(i, 11)) = i
    Next i
 
    Set dico2 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(v, 1)
        dico2(v(i, 11)) = i
    Next i
 
    lgn = 1
    For i = 1 To UBound(u, 1)
        'recopie les lignes de la feuille 1 sur la feuille Synthèse si elles n'existent pas sur la feuille 2
        If dico2.exists(u(i, 11)) = False Then
            Debug.Print "Ajout de 1: " & u(i, 11)
            lgn = lgn + 1
            For j = 1 To UBound(u, 2)
                Sheets("Synthèse").Cells(lgn, j) = u(i, j)
            Next j
        End If
    Next i
 
    For i = 1 To UBound(v, 1)
        If v(i, 11) <> "" Then  '--- contient un ID
            lgn = lgn + 1
            If dico1.exists(v(i, 11)) Then
                k = dico1(v(i, 11)) '--- n° ligne dans feuil1
                Debug.Print u(k, 11) & "<>" & v(i, 11), dico1(v(i, 11)) & "<>" & dico2(v(i, 11))
                'Si les lignes de f2 existent sur f1 on recopie sur Synthèse les ligne de f2 et on y colore les cellules différentes
                For j = 1 To UBound(v, 2)
                    Sheets("Synthèse").Cells(lgn, j) = v(i, j)
                    If u(k, j) <> v(i, j) Then
                        Debug.Print "-- " & u(k, j) & " --> " & v(i, j)
                        Sheets("Synthèse").Cells(lgn, j).Interior.Color = RGB(255, 255, 0)
                    End If
                Next j
            Else
                'Si les lignes de f2 n'existent pas sur f1, on les recopie telles qu'elles sur Synthèse
                Debug.Print "Ajout de 2: " & v(i, 11)
                For j = 1 To UBound(v, 2)
                    Sheets("Synthèse").Cells(lgn, j) = v(i, j)
                Next j
            End If
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

C'est en ligne 40 de ce code que l'on recherche où se trouve l'ID équivalent.
Les Debug.Print vous permettront de mieux voir ce qui se passe. A mettre en commentaire une fois que c'est bien compris.


Cordialement.

[anais83]

Bonjour, à tous les deux et merci pour votre aide!

@Tête de chat , oui tu as raison j'ai essayé de ne pas tester la différence sur j mais tester toujours la colonne 9 (K), mais cela a entrainé encore plus de bug.....

@EricDgn, Merci beaucoup pour ta réponse et pour ton aide, ça fonctionne très bien j'ai ajouté K comme variable ( k As long) j'espère que je n'ai pas fait de bêtises...



Merci beaucoup et bonne soirée à vous !
A.

[EricDgn]

Oui, il faut déclarer k as Long.

Je ne comprends d'ailleurs pas comment il se fait qu'il n'y ait pas eu de message d'erreur sur mon pc alors qu'il est bien indiqué Option Explicit.

Bonne continuation.

[jurassic pork]

Hello,

Je ne comprends d'ailleurs pas comment il se fait qu'il n'y ait pas eu de message d'erreur sur mon pc alors qu'il est bien indiqué Option Explicit.

Avec ton code initial en Excel 2019, j'ai bien un message d'erreur quand je fais compiler VBAProject. A noter que ton code est le seul dans un module VBA.

Ami calmant, J.P