Discussion :

[Leodams]

Bonjour,

Je souhaiterais connaître le code qui permettra de changer la couleur d'une cellule si la valeur est modifiée.
Cela me permettra de voir les corrections appliquées lors de l'exécution de la macro suivante:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Vérif_datacol()
 
 
Dim cell As Range
 
For Each cell In Sheets(" NEO T2.07 SCDM").Range("b1:b" & Sheets(" NEO T2.07 SCDM").Range("b65000").End(xlUp).Row)
 
Set c = Sheets("déploiement").Range("c:c").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
 If Not c Is Nothing Then
 Sheets("NEO T2.07 SCDM").Cells(cell.Row, 18) = Sheets("Status Report").Cells(c.Row, 10)
End If
Next cell
End Sub

[gFZT82]

Bonjour,

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Sub Vérif_datacol()
Dim cell As Range
    For Each cell In Sheets(" NEO T2.07 SCDM").Range("B1:B" & Sheets(" NEO T2.07 SCDM").Range("b65000").End(xlUp).Row)
        Set c = Sheets("déploiement").Range("C:C").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            Sheets("NEO T2.07 SCDM").Cells(cell.Row, 18) = Sheets("Status Report").Cells(c.Row, 10)
            Sheets("NEO T2.07 SCDM").Cells(cell.Row, 18).Interior.ColorIndex = 3 'Couleur de remplissage rouge
        End If
    Next cell
End Sub

Cordialement.

[Leodams]

Merci à toi pour cette réponse rapide.
Cependant la demande est de mettre en couleur seulement les cellules modifiées. Là, le code permet de mettre en rouge tous les valeurs trouvées.

La difficulté est que je ne peux pas attribuer une valeur précise pour le changement de couleur.
Je creuse mais c'est compliqué.

[gFZT82]

En l’état, ton programme effectue une recherche de valeur puis, si la valeur est trouvée, il remplace systématiquement la valeur de la cellule cible par la valeur de la cellule source (même si c’est par la même valeur).

Si tu souhaites affecter une couleur de remplissage aux cellules cibles qui ont changé de valeur, il suffit que tu fasses une comparaison avant de lui affecter la valeur de la cellule source.

Dis-moi si j’ai bien compris.

Cordialement.

[Leodams]

oui c'est tout fait ça . Il est vrai que le but est de comparer les colonnes entre deux feuille Excel et m'indiquer les valeurs différentes par une couleurs.

dans la deuxième étape, je pourrai appliquer le code que j'ai mentionné plus haut.

[gFZT82]

Tu peux essayer d'appliquer ce code (non testé)

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
Sub Vérif_datacol()
Dim cell As Range, C As Range
    With Sheets("NEO T2.07 SCDM")
    For Each cell In .Range("B1:B" & .Range("B65000").End(xlUp).Row)
        Set C = Sheets("déploiement").Range("C:C").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
        If Not C Is Nothing Then
            'On compare la valeur correspondant à la valeur trouvée avec celle de la cellule cible
            'Si les valeurs sont différentes
            If .Cells(cell.Row, 18) <> Sheets("Status Report").Cells(C.Row, 10) Then
                'On remplace la caleur cible
                .Cells(cell.Row, 18) = Sheets("Status Report").Cells(C.Row, 10)
                'On colorie la cellule cible en rouge
                .Cells(cell.Row, 18).Interior.ColorIndex = 3
            End If
        End If
    Next cell
    End With
End Sub

Cordialement.

[Leodams]

Le résultat : il m'efface tous les valeurs de la colonnes et me mets tous les cellules de la couleur rouge.

J'essaye de le faire en deux étapes:
1° Macro
d'abord je compare la colonne source et cible si différentes mettre juste la cellule en rouge, si identique pas de remplissage de la cellule.

2° remplace la valeur cible par la valeur source (correspond à ce que j'ai eu du ma à trouvé mais fonctionne bien).

Si tu as une idée juste pour la première macro.

[gFZT82]

Le résultat : il m'efface tous les valeurs de la colonne et me met toutes les cellules de la couleur rouge.

Je ne comprends pas cet effacement que tu décris.
Comparativement à ta macro initiale, la macro que je t’ai transmise ne change rien sur le traitement des valeurs. On effectue la copie des mêmes cellules. La seule différence, c’est que la copie n’est faite que si les valeurs sont différentes et c’est dans ce cas que la cellule est colorée en rouge.
Donc :
- pourquoi un effacement ? Il faudrait que la cellule copiée soit vide.
- pourquoi la macro initiale ne produit pas le même résultat ?
J’aurais besoin de disposer d’un fichier exemple pour y voir plus clair.

Cordialement.

[Leodams]

Bonjour,

Excuse pour la réponse tardive.

le code est bon mais seulement il me mets en rouge les valeurs qui ne change pas hors je souhaitais le contraire mais je me sers de ce que tu m'as donner c'est une bonne piste.

Merci Si j'arrive à faire un bon résultat je le remettrai.

[Leodams]

voilà:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Vérif_Doublons_Planing()
Dim mondico As Object, c
  [C:C].Interior.ColorIndex = xlNone
  'Vérification Doublon MA'
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("c2", [c65000].End(xlUp))
     mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("c2", [c65000].End(xlUp))
    If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 6
  Next c
End Sub

Plus adapater pour ce que je veux faire ça vérifie que les doublons

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Vérif_Doublons_Inventaire()
Dim mondico As Object, c
  [AA:AA].Interior.ColorIndex = xlNone
  'Vérification Doublon ID'
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In Range("aa2", [aa65000].End(xlUp))
     mondico.Item(c.Value) = mondico.Item(c.Value) + 1
  Next c
  For Each c In Range("aa2", [aa65000].End(xlUp))
    If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 6
  Next c
End Sub

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
Sub Vérif_pl()
 
Dim cell As Range
 
For Each cell In Sheets("déploiement").Range("c1:c" & Sheets("déploiement").Range("c65000").End(xlUp).Row)
 'Recherche avec Ma dans l'inventaire'
Set c = Sheets("Extract_Full_DCOL_EUR_FR_201303").Range("k:k").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
 If Not c Is Nothing Then
 'Renvoi le modele '
 Sheets("déploiement").Cells(cell.Row, 19) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 13)
  'Renvoi le Type'
 Sheets("déploiement").Cells(cell.Row, 13) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 12)
 'Renvoi la configuration'
 Sheets("déploiement").Cells(cell.Row, 12) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 25)
End If
Next cell
For Each cell In Sheets("déploiement").Range("j1:j" & Sheets("déploiement").Range("j65000").End(xlUp).Row)
 'Recherche avec ID dans l'inventaire'
Set c = Sheets("Extract_Full_DCOL_EUR_FR_201303").Range("aa:aa").Find(cell, LookIn:=xlValues, LookAt:=xlWhole)
 If Not c Is Nothing Then
 'Renvoi Mail '
 Sheets("déploiement").Cells(cell.Row, 9) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 32)
  'Renvoi Nom '
 Sheets("déploiement").Cells(cell.Row, 6) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 28)
 'Renvoi Prénom '
 Sheets("déploiement").Cells(cell.Row, 7) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 29)
 'Renvoi Entité '
 Sheets("déploiement").Cells(cell.Row, 5) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 1)
'Renvoi Profil'
 Sheets("déploiement").Cells(cell.Row, 11) = Sheets("Extract_Full_DCOL_EUR_FR_201303").Cells(c.Row, 26)
End If
Next cell
End Sub

Merci !