Как vlookup и вернуть цвет фона вместе со значением поиска в Excel?

Предположим, у вас есть таблица, как показано на скриншоте ниже. Теперь вы хотите проверить, находится ли указанное значение в столбце A, а затем вернуть соответствующее значение вместе с цветом фона в столбце C. Как этого добиться? Метод, описанный в статье, может помочь вам решить проблему.

Vlookup и возврат цвета фона со значением поиска с помощью пользовательской функции

Vlookup и возврат цвета фона со значением поиска с помощью пользовательской функции

Удивительный! Использование эффективных вкладок в Excel, таких как Chrome, Firefox и Safari!

Экономьте 50% своего времени и сокращайте тысячи щелчков мышью каждый день!

Пожалуйста, сделайте следующее, чтобы найти значение и вернуть его соответствующее значение вместе с цветом фона в Excel.

1. На листе, содержащем значение, которое вы хотите просмотреть, щелкните правой кнопкой мыши вкладку листа и выберите Просмотреть код из контекстного меню. Смотрите скриншот:

2. В дебюте Microsoft Visual Basic для приложений окно, скопируйте ниже код VBA в окно кода.

Код VBA 1: Vlookup и возврат цвета фона со значением поиска

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. Затем нажмите Вставить > Модульи скопируйте приведенный ниже код VBA 2 в окно модуля.

Код VBA 2: Vlookup и возврат цвета фона со значением поиска

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. После ввода двух кодов нажмите Сервис > дело. Затем проверьте Среда выполнения сценария Microsoft коробка в Ссылки - VBAProject диалоговое окно. Смотрите скриншот:

5. нажмите другой + Q ключи для выхода из Microsoft Visual Basic для приложений окно и вернитесь к рабочему листу.

6. Выберите пустую ячейку рядом с поисковым значением и введите формулу. =LookupKeepColor(E2,$A$1:$C$8,3) в панель формул и нажмите клавишу Enter.

Внимание: В формуле E2 содержит значение, которое вы будете искать, 1 австралийский доллар: 8 канадских долларов это диапазон таблицы, а число 3 означает, что соответствующее значение, которое вы вернете, находится в третьем столбце таблицы. Пожалуйста, измените их по своему усмотрению.

7. Продолжайте выбирать первую ячейку результата и перетащите маркер заливки вниз, чтобы получить все результаты вместе с их цветом фона. Смотрите скриншот.

Статьи по теме:

Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
Более 300 мощных функций. Поддерживает Office / Excel 2007-2019 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

Больше информации... Скачать бесплатно... Покупка ...

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Больше информации... Скачать бесплатно... Покупка ...

31 Comments
Login

Sort by Newest
- Best
- Popular
- Newest
- Oldest

You are guest

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.
mohamed · 1 years ago
Hi, Is this code working for office 2016 and later versions ?
- Reply
- To post as a guest, your comment is unpublished.
  gouravhere · 10 months ago
  
  no its not returning color.
  
  Reply
To post as a guest, your comment is unpublished.
Tundra · 1 years ago
I use times and dates from excel reports to create timesheets for our employees. If the specified date, for example, 2020/08/11 matches the date on the next tabs array (which contains many cells with the same date but different times) I want it to pull only the cell filled in orange which will be stated as 2020/08/11 7:45. Is this possible?
- Reply
To post as a guest, your comment is unpublished.
andi · 1 years ago
How I do
- Reply
To post as a guest, your comment is unpublished.
Evord · 1 years ago
Hello, i have a sheet with 10,948 rows, its taking some time to pull the information with colors, still waiting. Is this normal, or there is something wrong?
- Reply
To post as a guest, your comment is unpublished.
AK · 1 years ago
This was AWESOME! followed the steps and it works beautifully! Thank you!
- Reply
- To post as a guest, your comment is unpublished.
  Evord · 1 years ago
  
  I have many records, it takes too long to process, and the code keeps on running even after completion. Please help
  
  Reply
To post as a guest, your comment is unpublished.
Mike · 1 years ago
I have used this in Excel 2016 and only the data is transferred from Source to Target...….color is not transferred. Thoughts on what issue might be: Is it incompatibility with Excel 2016? Thanks. MT
- Reply
To post as a guest, your comment is unpublished.
Mayank Sharma · 1 years ago
i am getting the required cell color but i also need the lookup value as it is returning integer instead of string
- Reply
To post as a guest, your comment is unpublished.
Prashant · 2 years ago
Hi, Can i apply vlookup on color cells with no data in them
- Reply
To post as a guest, your comment is unpublished.
Richard S · 2 years ago
this works fine in office 2010, but not the 2013 version. Is there an update to the macro?
- Reply
To post as a guest, your comment is unpublished.
johnrojas944@gmail.com · 2 years ago
good afternoon bob to these codes you can change them in addition to the color call me the same color format and font that contains the cell

Thank you
- Reply
To post as a guest, your comment is unpublished.
Ari · 2 years ago
Is there any way to modify this to use as an Hlookup?
- Reply
To post as a guest, your comment is unpublished.
JonB22 · 2 years ago
I am returning a value, but not getting the color. used the sheet to sheet code, followed to a T. Any ideas on why I am not getting the color?
- Reply
To post as a guest, your comment is unpublished.
Ela · 2 years 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?
- Reply
To post as a guest, your comment is unpublished.
kmoen · 2 years 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?
- Reply
To post as a guest, your comment is unpublished.
asfanayaz@gmail.com · 3 years 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 :)
- Reply
- To post as a guest, your comment is unpublished.
  Bob · 2 years 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
  
  Reply
To post as a guest, your comment is unpublished.
Asfan · 3 years ago
this code working on same sheet, how can i look up color from one sheet to another?
- Reply
- To post as a guest, your comment is unpublished.
  Bob · 2 years 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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Ana · 2 years ago
  
  Hello Bob! The code works, however, for some reason it copies values from Sheet 2 to Sheet 1, but copies the cell formatting and leaves it in Sheet 2... It's hard to explain, but it basically splits one action (copy text + copy formation and paste it into the cell) into two. Do you know how to make it to do both on one sheet? Thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Brad Lehoux · 3 years ago
I would also like to VLOOKUP on sheet 2 and extract the data and background color from sheet 1
- Reply
- To post as a guest, your comment is unpublished.
  Bob · 2 years 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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Jennifer · 2 years ago
  
  It this to fix an error in the original code or is this to allow it to look up from a different sheet?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Bob · 2 years 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.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  alan · 2 years ago
  
  hello I didi it the procedure but i cant bring the background color in the new worksheet , i have a doubt if i put in correct way the comand strWB and strWS i puted this strWB = LookupRng.Reporte_Opcionales
  strWS = LookupRng.Imprimir Reporte_Opcionales is the name of my workbook
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Bob · 2 years ago
  
  I believe the lines are supposed to be the following (EXACTLY):
  
  strWB = LookupRng.Parent.Parent.Name
  
  strWS = LookupRng.Parent.Name
  
  I came up with this about 4 months ago so I don't remember exactly how I came up with this, but you weren't supposed to replace this code with anything else.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Sergio Salazar Brice · 2 years ago
  
  Bob, help me plese , colud you please check the code? im sure that you can fix it because it does brigme the background color from other sheet .
  
  by the way the code that is for work in the same sheet work but i need bring the data from other sheet :(.
  
  thanks in advance
  greetengs from Monterrey México.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  alansystem@hotmail.c · 2 years ago
  
  what the name in strWB has repeated Parent.Parent ???? does that correct?
  thanks in advance.
  
  Reply
To post as a guest, your comment is unpublished.
Sander Viet · 3 years ago
How do I change this code, in order for it to extract the background color from another sheet?
For example, I would like to use a VLOOKUP in Sheet 2, which extracts the data and background color from Sheet 1.
- Reply
- To post as a guest, your comment is unpublished.
  Jim · 3 years ago
  
  I have this exact same question! Any advice would be greatly appreciated.
  
  Reply

Войти в свою учетную запись

Сброс пароля