XL 2016 Recherche la valeur d'une cellule dans la colonne d'une autre feuille

Au_noun

XLDnaute Nouveau
Bonjour à tous,

SVP j'ai besoin de votre aide en VBA !Je suis débutante .

Voici mon problème, j'ai 2 onglets (feuil1 et feuil2). Feuil1 est composée de 3 colonnes (A,B,C) et Feuil2 est composée de 2 colonnes(A,B)

J'aimerais mettre en rouge la cellule de la colonne A "ID" (feuil1) Si [ pour chaque valeur de la colonne C "Link" de feuil1 , il y'a pas son équivalent dans la Colonne A de feuil2 (tout en parcourant toutes les cellules de la colonne A "ID" (feuil2 )) ] OU Si [la cellule de la colonne C de feuil1 est vide]

NB: en sachant que certaines cellules de la colonne C "Link" de feuil1 contiennent plusieurs valeurs (chaines de caractères)

Voici mon code :

Sub Analyser()

Dim i As Integer

For i = 2 To 18


If Cells(i, 3) = "" Then

Cells(i, 1).Interior.Color = RGB(255, 128, 128)


ElseIf Len(Cells(i, 3)) = 11 And IsError(Application.VLookup((Mid(Range("C" & i).Value, 1, 11)), Sheets("Feuil2").Range("A2:A22"), 1, False)) Then

Cells(i, 1).Interior.Color = RGB(255, 128, 128)


ElseIf Len(Cells(i, 5)) > 11 And IsError(Application.VLookup((Mid(Range("C" & i).Value, 27, 11)), Sheets("Feuil2").Range("A2:A22"), 1, False)) Then

Cells(i, 1).Interior.Color = RGB(255, 128, 128)

Else

Cells(i, 1).Interior.Color = RGB(255, 255, 255)


End If


Next

End Sub


PS: Mon code recherche seulement les 2 premières chaines de caractères, Or certaines cellules contiennent 4 chaines de caractères voire même 10. ça varie. J'aimerais créer une boucle qui permet de parcourir toutes les chaines de caractères d'une cellule avant d'aller au suivant.

J'ai beau tenté les différentes code sur le forum mais je n'y arrive pas.

Merci d'avance pour le coup de main!
 

Pièces jointes

  • Demo.xlsb
    19.2 KB · Affichages: 9
Solution
Re bonjour,
C'est plus clair maintenant,
Essaye alors ce code
VB:
Sub Analyser4()
    Application.ScreenUpdating = False
    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) = True Then
                   xNonTrouve = True
                Else
                    xNonTrouve = False
                End If
            Next F
            If xNonTrouve = True...

Lolote83

XLDnaute Barbatruc
Bonjour,
Essaye avec ce code
VB:
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
@+ Lolote83
 

Lolote83

XLDnaute Barbatruc
Re bonjour,
Une autre approche avec surbrillance du code trouvé parmi la chaine de caractères.
Code:
Sub Analyser3()
    Application.ScreenUpdating = False

    Range("A2:C18").Font.Bold = False
    Range("A2:C18").Font.ColorIndex = xlAutomatic
    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
                    xMot = Trim(xLesClass(F))
                    xPos = 1
                    Do While xPos > 0
                        xPos = InStr(xPos, xCell, xMot)
                        If xPos > 0 Then
                            With xCell.Characters(xPos, Len(xMot)).Font
                                .ColorIndex = 3     'ROUGE
                                .Bold = True
                            End With
                            xPos = xPos + Len(xMot)
                        End If
                    Loop
                    '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
    Application.ScreenUpdating = True
End Sub
 

Au_noun

XLDnaute Nouveau
Bonjour,

Je vous remercie pour votre réponse et votre temps.

Le code ne produit pas totalement le résultat que je recherche. Normalement les cellules A13 (C13), A14 (C14) et A18 (18) ne doivent pas être en rouge vu que l'ID CLASS-106192, CLASS-105753 dans les cellules C13, C14 et C18 de la Feuil 1 se trouve dans la colonne A de Feuil2.
 

Au_noun

XLDnaute Nouveau
Bonjour,
Est ce que ça serait possible de ne pas mettre A13, A14 et A18 en rouge?
Par contre A11 (Feuil1) est ok parce que CLASS-106192 se trouve dans la Feuil2

Je pense qu'il y'a un petit truc à modifier dans le code pour que ça marche parfaitement.
 

Lolote83

XLDnaute Barbatruc
Re bonjour,
Je ne comprends toujours pas car dans le dernier fichier transmis, seules les cellules vide (colonne C) sont coloriées.
Par contre, si tu veux vérifier les correspondances, il me semble que la cellule C4, C5, C10 etc etc n'étant pas dans la feuille2, donc pas de correspondance, les cellules de la colonne A ne devraient elles pas être coloriées ?
Pour moi, seule la cellule C13 étant corespondante, pas de coloriage. C'est donc la seule ligne qui ne devrait pas être coloriée.
@+ Lolote83
 

Au_noun

XLDnaute Nouveau
La condition c'est Si la cellule de la colonne C est vide, on met en rouge la même cellule sur la colonne A ET si la valeur de la cellule de la Colonne C ne se trouve pas dans la colonne A de Feuil2, alors on met aussi en rouge la même cellule sur la Colonne A de Feuil1.

J'ai mis une petite explication dans le fichier pour mieux comprendre avec le résultat attendu
 

Pièces jointes

  • demo2.xlsb
    20.3 KB · Affichages: 5

Au_noun

XLDnaute Nouveau
Les cellules de colonne A de feuil1 doivent être coloriés si elle remplie les conditions (c'est-à-dire si la cellule dans colonne C est vide Et si les valeurs de la cellule dans colonne C ne se trouve pas dans la Colonne A de Feuil2)

La première condition (si la cellule C est vide, la cellule A est en rouge) marche parfaitement.
 

Lolote83

XLDnaute Barbatruc
Re bonjour,
C'est plus clair maintenant,
Essaye alors ce code
VB:
Sub Analyser4()
    Application.ScreenUpdating = False
    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) = True Then
                   xNonTrouve = True
                Else
                    xNonTrouve = False
                End If
            Next F
            If xNonTrouve = True Then
                xCell.Offset(0, -2).Interior.Color = RGB(255, 128, 128)
            End If
        End If
    Next xCell
    Application.ScreenUpdating = True
End Sub
@+ Lolote83
 

Discussions similaires

Haut Bas