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

Pedz

XLDnaute Nouveau
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
 

Pièces jointes

  • Matrice FRS_MACRO.xlsm
    7.2 MB · Affichages: 114

Bebere

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

Code:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • Matrice FRS_MACROV1.xlsm
    7.4 MB · Affichages: 116

Pedz

XLDnaute Nouveau
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 ?
 

Pièces jointes

  • MatriceV9.xlsm
    7.7 MB · Affichages: 69

Bebere

XLDnaute Barbatruc
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
Code:
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
 

Pièces jointes

  • MatriceV10.xlsm
    8 MB · Affichages: 59
Dernière édition:

Pedz

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • MatriceV11.xlsm
    8 MB · Affichages: 65

Discussions similaires

Statistiques des forums

Discussions
314 450
Messages
2 109 724
Membres
110 552
dernier inscrit
jasson