Comparer 2 valeurs dans 2 feuilles différentes

Hello,

Je reviens encore vers pour une nième fois pour coup de pouce

Le code parcours les chaines de caractères (valeurs) de chaque cellule de la colonne C dans Feuil1 et recherche ces valeurs dans la colonne A de feuil2.

Les conditions sont :

1 - Si [la cellule de la colonne C est vide alors on met la cellule en rouge]

2- Sinon on recherche la (les) valeur(s) de la cellule dans la Feuil2!A, et Si une(les) valeur(s) ne se trouve pas dans Feuil2!A alors on met la cellule en rouge]

3 - Sinon si la valeur se trouve dans trouve dans Feuil2!A Et en plus de ça Feuil2!C < Feuil1!D, on met la cellule en Jaune sinon on laisse en blanc.

Les conditions 1 et 2 marchent parfaitement bien mais par contre j'ai essayé la condition 3, je n'y arrive pas

Je mets en pièce jointe le fichier Excel avec le résultat attendu et les explications

Sub Analyser4()

Dim LesClass, i As Variant
Dim x, NumRows, xPriority1, xPriority2 As Integer
Dim Cell As Range
Dim yCell As Range
Dim zCell As Range

Application.ScreenUpdating = False

NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count

For x = 2 To NumRows

    Range("A2:C18").Interior.Color = RGB(255, 255, 255)

   For Each Cell In Range("C" & x)

     'For Each yCell In Range("D" & x)

       'For Each zCell In Sheets("Feuil2").Range("C" & x)

        If IsEmpty(Cell.Value) = True Then
            Range("C" & x).End(xlDown).Interior.Color = RGB(255, 0, 0)
            

        Else
            LesClass = Split(Cell.Value, ",")
            'xPriorityI = Split(yCell.Value, "-")(0)
            'xPriorityP = Split(zCell.Value, "-")(0)
            'xPriority1 = Mid(Range("D" & x).Value, 2, 1)
            'xPriority2 = Mid(Sheets("Feuil2").Range("C" & x).Value, 2, 1)

            For i = 0 To UBound(LesClass)
                Equiv = Application.Match(Trim(LesClass(i)), Sheets("Feuil2").Columns(1), 0)

                If IsError(Equiv) = True Then
                   NonTrouve = True
                Else
                    NonTrouve = False

                    Exit For
                End If
            Next i
            If NonTrouve = True Then
                Range("C" & x).Interior.Color = RGB(255, 128, 128)

            'ElseIf NonTrouve = False And xPriority1 > xPriority2 Then
                'Range("C" & x).Interior.Color = RGB(224, 255, 96)

                'Exit For
                'Exit For
                Exit For 
            End If
        End If

        'Next
        'Next
    Next Cell
 Next x
    Application.ScreenUpdating = True
End Sub

Bonjour Anis97

Voici un nouveau code que tu peux tester:

'Sub Analyser2()
   ' Range("A2:C18").Interior.Color = RGB(255, 255, 255)
    'For Each xCell In Range("C2:C18")
        'If IsEmpty(xCell.Value) = True Then
            'xCell.Offset(0, -2).Interior.Color = RGB(255, 0, 0)
        'Else
           ' xLesClass = Split(xCell.Value, ",")
            'For F = 0 To UBound(xLesClass)
                'xEquiv = Application.Match(Trim(xLesClass(F)), Sheets("Feuil2").Range("A2:A22"), 0)
                'If IsError(xEquiv) = False Then
                    'MsgBox "Class trouvée" & Trim(xLesClass(F))
                   ' xCell.Offset(0, -2).Interior.Color = RGB(255, 128, 128)
                'End If
            'Next F
        'End If
    'Next xCell
'End Sub

Sub Analyser4()

Dim x, NumRows, xPriorityP, xPriorityI As Integer
Dim Cell As Range
Dim Cellbis As Range
Dim yCell As Range
Dim zCell As Range

    Application.ScreenUpdating = False
    Range("A2:C18").Interior.Color = RGB(255, 255, 255)
    For Each Cell In Range("C2:C18")

     'For Each yCell In Range("D" & x)

       'For Each zCell In Sheets("general_report problem").Range("C" & x)

        If IsEmpty(Cell.Value) = True Then
            'Range("C2").End(xlDown).Interior.Color = RGB(255, 0, 0)

            Cell.Offset(0, 0).Interior.Color = RGB(255, 0, 0)
        Else
            LesClass = Split(Cell.Value, ",")
            'xPriorityI = Split(yCell.Value, "-")(0)
            'xPriorityP = Split(zCell.Value, "-")(0)
            'xPriorityI = Mid(Range("D" & x).Value, 2, 1)
            'xPriorityP = Mid(Sheets("general_report problem").Range("C" & x).Value, 2, 1)

            For i = 0 To UBound(LesClass)
                equiv = Application.Match(Trim(LesClass(i)), Sheets("Feuil2").Range("A2:A22"), 0)
                If IsError(equiv) = True Then
                   NonTrouve = True
                Else
                    NonTrouve = False

                    Exit For
                End If
            Next i
            If NonTrouve = True Then
                Cell.Offset(0, 0).Interior.Color = RGB(255, 128, 128)
            Else
                With Sheets("Feuil2")
                    For Each Cellbis In .Range("A2:A22")
                        If Trim(Cellbis) = Trim(LesClass(i)) Then memoire = Left(Cellbis.Offset(0, 2), 2)
                    Next Cellbis
                End With
                If memoire < Left(Cell.Offset(0, 1), 2)  Then Cell.Interior.Color = RGB(255, 255, 0)
            End If
            'ElseIf IsError(xEquiv) = False And xPriorityP < xPriorityI Then
                'Range("A" & x).Interior.Color = RGB(224, 255, 96)

                'Exit For
                'Exit For

        End If

        'Next
        'Next
    Next Cell
    Application.ScreenUpdating = True
End Sub

A+

Bonjour Gabin37,

J'ai testé ton code. ça marche! Thank you !

Penses à marquer tes sujets en résolu lorsque tu as trouvé la solution

A+