XL 2016 MACRO reporte mise en forme conditionnelle en cas de modification

[Pedz]

Bonjour,

J'ai un problème de macro que je n'arrive pas à resoudre, du coup je viens demander un peu d'aide par ici.

Voilà mon problème, j'ai un onglet (Matrice2018 [1]) qui se construit à partir de recherchev de deux autres onglets (Matrice Jouet Cedemo FR [2]) du fichier et lors des mises à jour de l'onglet [2] les lignes sur lesquelles ils y a eu des modifications sont en gris et la ou les cellules modifiées en bleu.
J'aimerais lorsque qu'une cellule est bleue dans l'onglet [2] que la mise en forme se reporte sur la cellule de l'onglet [1] correspondante, en mettant le texte en rouge sur fond rouge clair par exemple (sachant que la disposition de l'onglet [1] n'est pas du tout le même que l'onglet [2])

Fichier exemple en PJ

Merci d'avance

 

[Bebere]

bonjour
Pedz voilà un code d'après ce que j'ai compris

Public Sub ChercheGrisBleu()
    Dim Ws As Worksheet, derL As Long, derC As Long, L As Long, C As Long
    Dim a(), i As Long, Cel As Range
    Set Ws = Worksheets("Matrice Jouet Cedemo FR")
    derL = Ws.Cells.Find("*", [A1], , , 1, 2).Row
    derC = Ws.Cells.Find("*", [A1], , , 2, 2).Column
    For L = 7 To derL
        If Ws.Cells(L, 1).Interior.Color = Ws.Range("F1").Interior.Color Then
            For C = 1 To derC
                If Ws.Cells(L, C).Interior.Color = Ws.Range("G1").Interior.Color Then
                    ReDim Preserve a(i): a(i) = Ws.Cells(L, C): i = i + 1
                End If
            Next C
        End If
    Next L
    Set Ws = Worksheets("Matrice2018")
    For i = LBound(a) To UBound(a)
        Set Cel = Ws.Cells.Find(a(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then Cel.Font.Color = vbRed: Cel.Interior.Color = vbYellow
    Next
End Sub
'pour les couleurs références à F1 et G1(copier/coller formats de B11 et C11)
'attention à mettre les mêmes couleurs ,en G11 une autre couleur utilisée et changée

 

[Pedz]

Merci beaucoup, j'essaye de tester ça dans la journée !

En tout cas, merci pour le temps passé.

 

[Pedz]

La macro fonctionne parfaitement sur l'exemple que j'ai envyé et c'est exactement ce que je voulais faire ! Merci !

Par contre lorsque je l'applique sur une matrice plus importante la mcro bug à cette étape :
For i = LBound(a) To UBound(a)

Pourrais-tu me dire à quoi sert cette ligne de code ? Est-ce que c'est parce que le tableau a plus de lignes ?

 

[Bebere]

Fedz c'est un tableau qui contient le contenu des cellules en bleu
es tu sûr qu'il est initialisé,regarde la variable i
cela vient certainement des cellules en bleu(le même bleu partout)
edit:ajout du fichier

 

[Pedz]

Effectivement en changeant le bleu de la cellule G1 la macro passe cette étape mais bloque à la suivante :

Set Cel = Ws.Cells.Find(a(i), LookIn:=xlValues, lookat:=xlWhole)

 

[Pedz]

Oui il y a un problème cela décale les cellules colorées dans la Matrice 2018 ?

Est-ce que je peux t'envoyer un autre fichier exemple avec plus de lignes pour voir où ça coince stp ?

 

[Bebere]

Pedz il y a des erreurs dans la feuille matice2018 (ex:colonne 68)

 

[Pedz]

Oui c'est parce que j'ai dû supprimer des tables pour raison de confidentialité. Tu penses que le problème vient de là ? Parce que sur une matrice "normale" il n'y a pas d'erreurs dans cette colonne.

 

[Pedz]

La macro va bien jusqu'au bout mais par exemple le code douane (colonne CG de la Matrice Jouet et BS de la Matrice 2018) il y a beaucoup de cellules bleues mais elle ne se reporte par correctement de l'autre coté.

 

[Bebere]

Fedz essaye ce code,içi çà s'arrêtait sur l'erreur dans la feuille
changé la fin du code,fait2 boucles à la place de find,à surveiller aussi la colonne date

Public Sub ChercheGrisBleu()
    Dim Ws As Worksheet, derL As Long, derC As Long, L As Long, C As Long
    Dim a(), i As Long, Cel As Range
    Set Ws = Worksheets("Matrice Jouet Cedemo FR")
    derL = Ws.Cells.Find("*", [A1], , , 1, 2).Row
    derC = Ws.Cells.Find("*", [A1], , , 2, 2).Column
    For L = 7 To derL
        If Ws.Cells(L, 1).Interior.Color = Ws.Range("F1").Interior.Color Then
            For C = 1 To derC
                If Ws.Cells(L, C).Interior.Color = Ws.Range("G1").Interior.Color Then
                    ReDim Preserve a(i): a(i) = Ws.Cells(L, C): i = i + 1
                End If
            Next C
        End If
    Next L
    Set Ws = Worksheets("Matrice2018")
    derL = Ws.Cells.Find("*", [A1], , , 1, 2).Row
    derC = Ws.Cells.Find("*", [A1], , , 2, 2).Column
    For i = LBound(a) To UBound(a)
        For L = 7 To derL
            For C = 1 To derC
                If Not IsError(Ws.Cells(L, C)) Then
                    If Ws.Cells(L, C) = a(i) Then Ws.Cells(L, C).Font.Color = vbRed: Ws.Cells(L, C).Interior.Color = vbYellow
                End If
            Next
        Next
    Next
End Sub

edit: ajout fichier,code module 1 et 2

 

[Pedz]

Bonjour,

La macro tourne bien jusqu'au bout mais j'ai toujours le problème de cellules qui ne correspondent pas dans l'onglet Matrice18.

Je pense que c'est très proche de fonctionner mais comme je ne comprends pas exactement ton code, je n'arrive pas pas à le corriger.

 

[Bebere]

bonjour
Pedz
as tu testé le fichier(dernière version) ou le code

 

[Pedz]

J'ai fait tourner ton code depuis la MatriceV10 que tu as fait en colorant avant les cellules G1 & F1 du fichier sur lequel je veux appliquer la macro.

 

[Bebere]

Pedz ajout d'une condition sur la colonne 71
je pense que c'est ce que tu veux,sinon explique avec exemple
le code n'est pas difficile il recherche la description correspondante dans matrice et met les cellules qui correspondent aux bleues de l'autre feuille en jaune