Astuce: Les autres langues sont Google-Traduction. Vous pouvez visiter le English version de ce lien.
Se connecter
x
or
x
x
S'enregistrer
x

or

Comment vlookup et retourner la couleur d'arrière-plan avec la valeur de recherche dans Excel?

Supposons que vous ayez une table comme ci-dessous. Maintenant, vous voulez vérifier si une valeur spécifiée est dans la colonne A, puis retourner la valeur correspondante avec la couleur de fond dans la colonne C. Comment l'obtenir? La méthode de l'article peut vous aider à résoudre le problème.

Vlookup et renvoie la couleur d'arrière-plan avec la valeur de recherche par fonction définie par l'utilisateur


Vlookup et renvoie la couleur d'arrière-plan avec la valeur de recherche par fonction définie par l'utilisateur


Procédez comme suit pour rechercher une valeur et renvoyer sa valeur correspondante avec la couleur d'arrière-plan dans Excel.

1. Dans la feuille de calcul contient la valeur que vous souhaitez vlookup, cliquez avec le bouton droit sur l'onglet de feuille et sélectionnez Voir le code dans le menu contextuel. Voir la capture d'écran:

2. Dans l'ouverture Microsoft Visual Basic pour applications fenêtre, veuillez copier ci-dessous le code VBA dans la fenêtre Code.

Code VBA 1: Vlookup et renvoie la couleur d'arrière-plan avec la valeur de recherche

Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long
    Dim xKeys As Long
    Dim xDicStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            If xDicStr <> "" Then
                Range(xDic.Keys(I)).Interior.Color = _
                Range(xDic.Items(I)).Interior.Color
            Else
                Range(xDic.Keys(I)).Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
End Sub

3. Puis clique insérer > Moduleet copiez le code VBA 2 ci-dessous dans la fenêtre Module.

Code VBA 2: Vlookup et renvoie la couleur d'arrière-plan avec la valeur de recherche

Public xDic As New Dictionary
Function LookupKeepColor (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepColor = ""
        xDic.Add Application.Caller.Address, ""
    Else
        LookupKeepColor = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address
    End If
End Function

4. Après avoir inséré les deux codes, cliquez sur Outils > Les références. Ensuite, vérifiez le Microsoft Script Runtime boîte dans la Références - VBAProject boite de dialogue. Voir la capture d'écran:

5. appuie sur le autre + Q touches pour quitter le Microsoft Visual Basic pour applications fenêtre et revenir à la feuille de calcul.

6. Sélectionnez une cellule vide adjacente à la valeur de recherche, puis entrez la formule =LookupKeepColor(E2,$A$1:$C$8,3) dans la barre de formule, puis appuyez sur la touche Entrée.

Note: Dans la formule, E2 contient la valeur que vous allez rechercher, $ A $ 1: $ C $ 8 est la plage de table et le nombre 3 signifie que la valeur correspondante que vous retournerez se situe dans la troisième colonne du tableau. S'il vous plaît, changez-les selon vos besoins.

7. Continuez à sélectionner la première cellule de résultat et faites glisser la poignée de remplissage vers le bas pour obtenir tous les résultats avec leur couleur d'arrière-plan. Voir la capture d'écran.


Articles Liés:



Outils de productivité recommandés

Office Tab

étoile d&#39;or1 Apportez des onglets pratiques à Excel et à d'autres logiciels Office, tout comme Chrome, Firefox et Internet Explorer.

Kutools for Excel

étoile d&#39;or1 Incroyable! Augmentez votre productivité dans les minutes 5. Ne nécessite pas de compétences particulières, économisez deux heures par jour!

étoile d&#39;or1 300 Nouvelles fonctionnalités pour Excel, rendent Excel facile et puissant:

  • Fusionner des cellules / lignes / colonnes sans perdre de données.
  • Combiner et consolider plusieurs feuilles et classeurs.
  • Comparez les gammes, copiez plusieurs gammes, convertissez le texte en date, l'unité et la conversion de devise.
  • Compter par couleurs, sous-totaux de recherche, tri avancé et super filtre,
  • Plus Sélectionner / Insérer / Supprimer / Texte / Format / Lier / Commenter / Classeurs / Feuilles de calcul Outils ...

Capture d&#39;écran de Kutools pour Excel

Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Ela · 28 days ago
    When I open the View Code window, there is a window but is not empty. Can I paste the code under the text that is already there or how do I open a new "blank page" please?
  • To post as a guest, your comment is unpublished.
    K Moen · 1 months ago
    I have windows for Mac , when I get to Step 4 - there is no option for Microsoft Scripting Runtime, is there something else I should be selecting?
  • To post as a guest, your comment is unpublished.
    Asfan Ayaz · 5 months ago
    this code is running on same sheet but how can I lookup cell color from one sheet to another sheet in excel
    Thanks in advance :)
    • To post as a guest, your comment is unpublished.
      Bob · 2 months ago
      Use this slight modification of the code posted.


      Public xDic As New Dictionary
      Public strWB As String
      Public strWS As String

      Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
      Dim xFindCell As Range
      On Error Resume Next

      strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
      strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

      Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

      If xFindCell Is Nothing Then
      CLookup = ""
      xDic.Add Application.Caller.Address, ""
      Else
      CLookup = xFindCell.Offset(0, xCol - 1).Value
      xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

      End If
      End Function

      Sub Worksheet_Change(ByVal Target As Range)
      Dim I As Long
      Dim xKeys As Long
      Dim xDicStr As String
      Dim rngLoc As Range
      On Error Resume Next
      Application.ScreenUpdating = False
      xKeys = UBound(xDic.Keys)
      If xKeys >= 0 Then
      For I = 0 To UBound(xDic.Keys)
      xDicStr = xDic.Items(I)
      If xDicStr <> "" Then
      Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
      Else
      Range(xDic.Keys(I)).Interior.Color = xlNone
      End If
      Next
      Set xDic = Nothing
      End If
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Asfan · 5 months ago
    this code working on same sheet, how can i look up color from one sheet to another?
    • To post as a guest, your comment is unpublished.
      Bob · 2 months ago
      Use this slight modification of the code posted.


      Public xDic As New Dictionary
      Public strWB As String
      Public strWS As String

      Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
      Dim xFindCell As Range
      On Error Resume Next

      strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
      strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

      Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

      If xFindCell Is Nothing Then
      CLookup = ""
      xDic.Add Application.Caller.Address, ""
      Else
      CLookup = xFindCell.Offset(0, xCol - 1).Value
      xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

      End If
      End Function

      Sub Worksheet_Change(ByVal Target As Range)
      Dim I As Long
      Dim xKeys As Long
      Dim xDicStr As String
      Dim rngLoc As Range
      On Error Resume Next
      Application.ScreenUpdating = False
      xKeys = UBound(xDic.Keys)
      If xKeys >= 0 Then
      For I = 0 To UBound(xDic.Keys)
      xDicStr = xDic.Items(I)
      If xDicStr <> "" Then
      Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
      Else
      Range(xDic.Keys(I)).Interior.Color = xlNone
      End If
      Next
      Set xDic = Nothing
      End If
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Brad Lehoux · 9 months ago
    I would also like to VLOOKUP on sheet 2 and extract the data and background color from sheet 1
    • To post as a guest, your comment is unpublished.
      Bob · 2 months ago
      Use this slight modification of the code posted.


      Public xDic As New Dictionary
      Public strWB As String
      Public strWS As String

      Function CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
      Dim xFindCell As Range
      On Error Resume Next

      strWB = LookupRng.Parent.Parent.Name '*** Remember the Workbook where the data and color are coming from
      strWS = LookupRng.Parent.Name '*** Remember the Worksheet where the data and color are coming from

      Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

      If xFindCell Is Nothing Then
      CLookup = ""
      xDic.Add Application.Caller.Address, ""
      Else
      CLookup = xFindCell.Offset(0, xCol - 1).Value
      xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address

      End If
      End Function

      Sub Worksheet_Change(ByVal Target As Range)
      Dim I As Long
      Dim xKeys As Long
      Dim xDicStr As String
      Dim rngLoc As Range
      On Error Resume Next
      Application.ScreenUpdating = False
      xKeys = UBound(xDic.Keys)
      If xKeys >= 0 Then
      For I = 0 To UBound(xDic.Keys)
      xDicStr = xDic.Items(I)
      If xDicStr <> "" Then
      Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
      Else
      Range(xDic.Keys(I)).Interior.Color = xlNone
      End If
      Next
      Set xDic = Nothing
      End If
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Jennifer · 2 months ago
        It this to fix an error in the original code or is this to allow it to look up from a different sheet?
        • To post as a guest, your comment is unpublished.
          Bob · 2 months ago
          This change to the original code allows you to do the vlookup w/color from one Worksheet to another or from one Workbook to another. But this code needs to be placed in the TARGET worksheet rather than the SOURCE worksheet as was described in the original code. That's because the original code only worked in one Worksheet, so it was both the Source and the Target. This is not a fix to the original code. I just added code to allow you to pull from any Workbook/Worksheet (Source) into your Worksheet (Target). The original code worked as the programmer intended.