Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

A

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: 10
Solution
L
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...
Trier par date Trier par votes
L

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
 
Vote positif 0 Vote négatif
L

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
 
Vote positif 0 Vote négatif
A

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.
 
Vote positif 0 Vote négatif
L

Lolote83

XLDnaute Barbatruc
Re bonjour,
Oups, j'ai inversé
il y'a pas son équivalent dans la Colonne A
Cliquez pour agrandir...
Moi, j'ai recherché l'équivalence
Par contre, peux tu re-joindre ton fichier avec les données coloriées à la main afin de mieux me rendre compte du résultat attendu.
Du coup, je modifie en espérant avoir bien compris maintenant

@+ Lolote83
 
Vote positif 0 Vote négatif
A

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.
 
Vote positif 0 Vote négatif
L

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
 
Vote positif 0 Vote négatif
A

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: 8
Vote positif 0 Vote négatif
A

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.
 
Vote positif 0 Vote négatif
L

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
 
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2016 Mettre la même couleur de la dernière cellule colorée
Réponses
5
Affichages
295
TooFatBoy
R
  • Question
Microsoft 365 Couleur de fond de textbox [CLOTURE]
Réponses
2
Affichages
662
romubzh35
R
R
  • Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
415
Aya_flo
A
A
  • Question
XL 2016 Macro et rajout d'un chiffre au nom d'un Shape
Réponses
9
Affichages
566
alain.raphael
A
  • Question
Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne
Réponses
5
Affichages
361
patricktoulon
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
882
Dudy
D
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
324
CathyLD
C
  • Question
XL 2010 Comment lire array dans item dictionnaire
2 3
Réponses
33
Affichages
2 K
cathodique
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
314
souhaib ad
S
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
927
Nicolas JACQUIN
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…