Note: The other languages of the website are Google-translated. Back to English

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

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

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


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

Пожалуйста, сделайте следующее, чтобы найти значение и вернуть его соответствующее значение вместе с цветом фона в 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-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

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

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (34)
Номинальный 5 из 5 · рейтинги 1
Этот комментарий был сведен к минимуму модератором на сайте
Как изменить этот код, чтобы он извлекал цвет фона из другого листа?
Например, я хотел бы использовать функцию ВПР на листе 2, которая извлекает данные и цвет фона из листа 1.
Этот комментарий был сведен к минимуму модератором на сайте
У меня точно такой же вопрос! Мы будем очень признательны за любые советы.
Этот комментарий был сведен к минимуму модератором на сайте
Я также хотел бы выполнить VLOOKUP на листе 2 и извлечь данные и цвет фона из листа 1.
Этот комментарий был сведен к минимуму модератором на сайте
Используйте эту небольшую модификацию опубликованного кода.


Публичный xDic как новый словарь
Публичный strWB как строка
Публичный strWS как строка

Функция CLookup (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell как диапазон
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Запомните рабочую книгу, из которой берутся данные и цвет
strWS = LookupRng.Parent.Name '*** Запомните рабочий лист, откуда берутся данные и цвет

Установить xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

Если xFindCell — ничто, то
CLookup = ""
xDic.Add Application.Caller.Address, ""
Еще
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 как диапазон)
Дим я пока
Dim xKeys As Long
Dim xDicStr как строка
Dim rngLoc As Range
On Error Resume Next
Приложение.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
Если xKeys >= 0 Тогда
Для I = 0 в UBound(xDic.Keys)
xDicStr = xDic.Items(I)
Если xDicStr <> "" Тогда
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Еще
Диапазон (xDic.Keys (I)).Interior.Color = xlNone
End If
Далее
Установите xDic = Ничего
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Это для исправления ошибки в исходном коде или для того, чтобы он мог искать с другого листа?
Этот комментарий был сведен к минимуму модератором на сайте
Это изменение в исходном коде позволяет вам выполнять vlookup с цветом из одного рабочего листа в другой или из одной рабочей книги в другую. Но этот код необходимо поместить в рабочий лист TARGET, а не в рабочий лист SOURCE, как это было описано в исходном коде. Это потому, что исходный код работал только на одном рабочем листе, то есть это был и источник, и цель. Это не исправление исходного кода. Я только что добавил код, позволяющий вам извлекать данные из любой рабочей книги/рабочего листа (исходного) в рабочий лист (целевой). Исходный код работал так, как задумал программист.
Этот комментарий был сведен к минимуму модератором на сайте
привет, я выполнил эту процедуру, но я не могу внести цвет фона в новый рабочий лист, у меня есть сомнения, правильно ли я ввел команду strWB и strWS, я поставил это strWB = LookupRng.Reporte_Opcionales
strWS = LookupRng.Imprimir Reporte_Opcionales — это имя моей рабочей книги.
Этот комментарий был сведен к минимуму модератором на сайте
Я считаю, что строки должны быть следующими (ТОЧНО):

strWB = LookupRng.Parent.Parent.Name

strWS = LookupRng.Parent.Name


Я придумал это около 4 месяцев назад, поэтому я точно не помню, как я это придумал, но вы не должны были заменять этот код чем-либо другим.
Этот комментарий был сведен к минимуму модератором на сайте
что имя в strWB повторилось Parent.Parent ???? это правильно?
спасибо заранее.
Этот комментарий был сведен к минимуму модератором на сайте
Боб, помоги мне, пожалуйста, не мог бы ты проверить код? я уверен, что вы можете это исправить, потому что он меняет цвет фона с другого листа.

кстати, код для работы на том же листе работает, но мне нужно принести данные с другого листа :(.

заранее спасибо
приветствия из Монтеррея, Мексика.
Этот комментарий был сведен к минимуму модератором на сайте
Это прекрасно работает, спасибо!
Номинальный 5 из 5
Этот комментарий был сведен к минимуму модератором на сайте
этот код работает на одном листе, как я могу найти цвет с одного листа на другой?
Этот комментарий был сведен к минимуму модератором на сайте
Используйте эту небольшую модификацию опубликованного кода.


Публичный xDic как новый словарь
Публичный strWB как строка
Публичный strWS как строка

Функция CLookup (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell как диапазон
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Запомните рабочую книгу, из которой берутся данные и цвет
strWS = LookupRng.Parent.Name '*** Запомните рабочий лист, откуда берутся данные и цвет

Установить xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

Если xFindCell — ничто, то
CLookup = ""
xDic.Add Application.Caller.Address, ""
Еще
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 как диапазон)
Дим я пока
Dim xKeys As Long
Dim xDicStr как строка
Dim rngLoc As Range
On Error Resume Next
Приложение.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
Если xKeys >= 0 Тогда
Для I = 0 в UBound(xDic.Keys)
xDicStr = xDic.Items(I)
Если xDicStr <> "" Тогда
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Еще
Диапазон (xDic.Keys (I)).Interior.Color = xlNone
End If
Далее
Установите xDic = Ничего
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет Боб! Код работает, однако, по какой-то причине он копирует значения с Листа 2 на Лист 1, но копирует форматирование ячейки и оставляет его на Листе 2... Это сложно объяснить, но в основном он разделяет одно действие (копирование текста + копирование формирования и вставить в ячейку) на два. Вы знаете, как сделать так, чтобы сделать это на одном листе? Благодарю вас!
Этот комментарий был сведен к минимуму модератором на сайте
этот код работает на одном листе, но как я могу найти цвет ячейки с одного листа на другой лист в excel
Заранее спасибо :)
Этот комментарий был сведен к минимуму модератором на сайте
Используйте эту небольшую модификацию опубликованного кода.


Публичный xDic как новый словарь
Публичный strWB как строка
Публичный strWS как строка

Функция CLookup (ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
Dim xFindCell как диапазон
On Error Resume Next

strWB = LookupRng.Parent.Parent.Name '*** Запомните рабочую книгу, из которой берутся данные и цвет
strWS = LookupRng.Parent.Name '*** Запомните рабочий лист, откуда берутся данные и цвет

Установить xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)

Если xFindCell — ничто, то
CLookup = ""
xDic.Add Application.Caller.Address, ""
Еще
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 как диапазон)
Дим я пока
Dim xKeys As Long
Dim xDicStr как строка
Dim rngLoc As Range
On Error Resume Next
Приложение.ScreenUpdating = False
xKeys = UBound(xDic.Keys)
Если xKeys >= 0 Тогда
Для I = 0 в UBound(xDic.Keys)
xDicStr = xDic.Items(I)
Если xDicStr <> "" Тогда
Range(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
Еще
Диапазон (xDic.Keys (I)).Interior.Color = xlNone
End If
Далее
Установите xDic = Ничего
End If
Application.ScreenUpdating = True
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
У меня есть Windows для Mac, когда я перехожу к шагу 4, для Microsoft Scripting Runtime нет опции, есть ли что-то еще, что я должен выбрать?
Этот комментарий был сведен к минимуму модератором на сайте
Когда я открываю окно просмотра кода, оно есть, но оно не пустое. Можно ли вставить код под уже существующим текстом или как открыть новую "пустую страницу" пожалуйста?
Этот комментарий был сведен к минимуму модератором на сайте
Я возвращаю значение, но не получаю цвет. использовал код листа для листа, а затем букву T. Любые идеи о том, почему я не получаю цвет?
Этот комментарий был сведен к минимуму модератором на сайте
Есть ли способ изменить это для использования в качестве Hlookup?
Этот комментарий был сведен к минимуму модератором на сайте
добрый день боб к этим кодам вы можете изменить их в дополнение к цвету позвоните мне тот же формат цвета и шрифт, который содержит ячейка

спасибо
Этот комментарий был сведен к минимуму модератором на сайте
это отлично работает в офисе 2010, но не в версии 2013 года. Есть ли обновление макроса?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Могу ли я применить vlookup к цветным ячейкам без данных в них?
Этот комментарий был сведен к минимуму модератором на сайте
я получаю требуемый цвет ячейки, но мне также нужно значение поиска, поскольку оно возвращает целое число вместо строки
Этот комментарий был сведен к минимуму модератором на сайте
Я использовал это в Excel 2016, и только данные передаются из источника в цель ...... цвет не передается. Мысли по какому вопросу могут быть: Это несовместимость с Excel 2016? Спасибо. МТ
Этот комментарий был сведен к минимуму модератором на сайте
Это было УДИВИТЕЛЬНО! следовал инструкциям, и это прекрасно работает! Благодарю вас!
Этот комментарий был сведен к минимуму модератором на сайте
У меня много записей, обработка занимает слишком много времени, и код продолжает работать даже после завершения. Пожалуйста помоги
Этот комментарий был сведен к минимуму модератором на сайте
Привет, у меня есть лист с 10,948 XNUMX строками, требуется некоторое время, чтобы извлечь информацию с цветами, все еще жду. Это нормально, или что-то не так?
Этот комментарий был сведен к минимуму модератором на сайте
Как я сделаю
Этот комментарий был сведен к минимуму модератором на сайте
Я использую время и даты из отчетов Excel для создания табелей учета рабочего времени для наших сотрудников. Если указанная дата, например, 2020/08/11, совпадает с датой в следующем массиве вкладок (который содержит много ячеек с одинаковой датой, но разным временем), я хочу, чтобы он вытягивал только ячейку, заполненную оранжевым цветом, которая будет указана как 2020 08:11. Это возможно?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, этот код работает для офиса 2016 и более поздних версий?
Этот комментарий был сведен к минимуму модератором на сайте
нет, он не возвращает цвет.
Этот комментарий был сведен к минимуму модератором на сайте
Этот код работает нормально, за исключением ячеек, в которые вводится формула, выводит 0, когда ячейка, которую она ищет, пуста, мой вопрос в том, как заставить ее игнорировать пустые ячейки и предотвратить ввод формулы в ячейку a 0, может быть, в коде есть какие-то места для ввода функции =IFERROR?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Кайл,

Я протестировал этот код, и он не выводит 0, когда ячейка, которую он ищет, пуста.
Возможно, вы могли бы включить формулу в функцию ЕСЛИ, как показано ниже, чтобы предотвратить возврат результата 0.
=ЕСЛИ(B2="","",LookupKeepColor(E2,$A$1:$C$8,3))
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL