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

如何在Excel中進行vlookup並返回背景色以及查找值?

假設您有一個表格,如下所示。 現在,您要檢查指定的值是否在A列中,然後在C列中返回相應的值以及背景色。如何實現? 本文中的方法可以幫助您解決問題。

Vlookup並通過用戶定義的函數返回具有查找值的背景色


Vlookup並通過用戶定義的函數返回具有查找值的背景色

請執行以下操作以在Excel中查找值並返回其對應的值以及背景色。

1.在工作表中包含您要vlookup的值,右鍵單擊工作表選項卡,然後選擇 查看代碼 從上下文菜單中。 看截圖:

2.在開幕 Microsoft Visual Basic for Applications 窗口,請將下面的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 for Applications 窗口,然後返回工作表。

6.選擇一個與查詢值相鄰的空白單元格,然後輸入公式 =LookupKeepColor(E2,$A$1:$C$8,3) 進入公式欄,然後按Enter鍵。

備註: 在公式, E2 包含您將要查找的值, $ A $ 1:$ C $ 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中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (34)
5中的5評分 · 1評級
網站主持人對此評論進行了最小化
如何更改此代碼,以便從另一張紙中提取背景顏色?
例如,我想在 Sheet 2 中使用 VLOOKUP,它從 Sheet 1 中提取數據和背景顏色。
網站主持人對此評論進行了最小化
我有這個完全相同的問題! 任何建議將不勝感激。
網站主持人對此評論進行了最小化
我還想在表 2 上進行 VLOOKUP 並從表 1 中提取數據和背景顏色
網站主持人對此評論進行了最小化
使用發布的代碼的這種輕微修改。


作為新詞典的公共 xDic
公共 strWB 作為字符串
公共 strWS 作為字符串

函數 CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
將 xFindCell 調暗為範圍
在錯誤恢復下一頁

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

如果結束
函數結束

sub Worksheet_change(byval目標作為範圍)
暗淡我只要
調暗 xKeys
將 xDicStr 調暗為字符串
Dim rngLoc 作為範圍
在錯誤恢復下一頁
Application.ScreenUpdating = False
Xkeys = Ubound(xdic.keys)
如果 xKeys >= 0 那麼
對於 I = 0 到 UBound(xDic.Keys)
xdicstr = xdic.items(i)
如果 xDicStr <> "" 那麼
範圍(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
其他
範圍(xDic.Keys(I))。Interior.Color = xlNone
如果結束
下一頁
設置 xDic = 無
如果結束
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 ???? 對嗎?
在此先感謝。
網站主持人對此評論進行了最小化
Bob,請幫幫我,請檢查代碼? 我確定你可以修復它,因為它確實會從其他工作表中獲取背景顏色。

順便說一句,用於在同一張工作表中工作的代碼,但我需要從其他工作表中獲取數據:(。

在此先感謝
來自墨西哥蒙特雷的問候語。
網站主持人對此評論進行了最小化
這很好用,謝謝!
5中的5評分
網站主持人對此評論進行了最小化
此代碼在同一張紙上工作,我如何從一張紙查找顏色到另一張紙?
網站主持人對此評論進行了最小化
使用發布的代碼的這種輕微修改。


作為新詞典的公共 xDic
公共 strWB 作為字符串
公共 strWS 作為字符串

函數 CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
將 xFindCell 調暗為範圍
在錯誤恢復下一頁

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

如果結束
函數結束

sub Worksheet_change(byval目標作為範圍)
暗淡我只要
調暗 xKeys
將 xDicStr 調暗為字符串
Dim rngLoc 作為範圍
在錯誤恢復下一頁
Application.ScreenUpdating = False
Xkeys = Ubound(xdic.keys)
如果 xKeys >= 0 那麼
對於 I = 0 到 UBound(xDic.Keys)
xdicstr = xdic.items(i)
如果 xDicStr <> "" 那麼
範圍(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
其他
範圍(xDic.Keys(I))。Interior.Color = xlNone
如果結束
下一頁
設置 xDic = 無
如果結束
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
你好鮑勃! 但是,該代碼有效,由於某種原因,它將值從工作表 2 複製到工作表 1,但複製單元格格式並將其保留在工作表 2 中......這很難解釋,但它基本上拆分了一個操作(複製文本 + 複製格式並將其粘貼到單元格中)一分為二。 你知道如何讓它在一張紙上同時完成嗎? 謝謝!
網站主持人對此評論進行了最小化
此代碼在同一張紙上運行,但我如何在 Excel 中從一張紙查找單元格顏色到另一張紙
感謝提前:)
網站主持人對此評論進行了最小化
使用發布的代碼的這種輕微修改。


作為新詞典的公共 xDic
公共 strWB 作為字符串
公共 strWS 作為字符串

函數 CLookup(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
將 xFindCell 調暗為範圍
在錯誤恢復下一頁

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

如果結束
函數結束

sub Worksheet_change(byval目標作為範圍)
暗淡我只要
調暗 xKeys
將 xDicStr 調暗為字符串
Dim rngLoc 作為範圍
在錯誤恢復下一頁
Application.ScreenUpdating = False
Xkeys = Ubound(xdic.keys)
如果 xKeys >= 0 那麼
對於 I = 0 到 UBound(xDic.Keys)
xdicstr = xdic.items(i)
如果 xDicStr <> "" 那麼
範圍(xDic.Keys(I)).Interior.Color = Application.Workbooks(strWB).Worksheets(strWS).Range(xDic.Items(I)).Interior.Color
其他
範圍(xDic.Keys(I))。Interior.Color = xlNone
如果結束
下一頁
設置 xDic = 無
如果結束
Application.ScreenUpdating = True
END SUB
網站主持人對此評論進行了最小化
我有 Mac 的 windows ,當我進入第 4 步時 - 沒有 Microsoft Scripting Runtime 選項,我還應該選擇其他什麼嗎?
網站主持人對此評論進行了最小化
當我打開查看代碼窗口時,有一個窗口但不是空的。 我可以將代碼粘貼在已經存在的文本下嗎?或者如何打開一個新的“空白頁”?
網站主持人對此評論進行了最小化
我正在返回一個值,但沒有得到顏色。 使用工作表到工作表代碼,然後是 T。關於為什麼我沒有得到顏色的任何想法?
網站主持人對此評論進行了最小化
有沒有辦法修改它以用作 Hlookup?
網站主持人對此評論進行了最小化
下午好,鮑勃這些代碼除了顏色之外,您還可以更改它們給我打電話給包含單元格的相同顏色格式和字體

謝謝
網站主持人對此評論進行了最小化
這在 Office 2010 中運行良好,但在 2013 版本中運行良好。 宏有更新嗎?
網站主持人對此評論進行了最小化
嗨,我可以在其中沒有數據的顏色單元格上應用 vlookup
網站主持人對此評論進行了最小化
我得到了所需的單元格顏色,但我還需要查找值,因為它返回整數而不是字符串
網站主持人對此評論進行了最小化
我在 Excel 2016 中使用過這個,只有數據從源傳輸到目標......。顏色沒有傳輸。 關於可能是什麼問題的想法:它是否與 Excel 2016 不兼容? 謝謝。 公噸
網站主持人對此評論進行了最小化
這太棒了! 按照步驟操作,效果很好! 謝謝!
網站主持人對此評論進行了最小化
我有很多記錄,處理時間太長,完成後代碼還在運行。 請幫忙
網站主持人對此評論進行了最小化
您好,我有一張 10,948 行的表格,它需要一些時間來提取顏色信息,仍在等待。 這是正常的,還是有什麼問題?
網站主持人對此評論進行了最小化
我怎樣做
網站主持人對此評論進行了最小化
我使用 Excel 報告中的時間和日期為我們的員工創建時間表。 如果指定的日期,例如 2020/08/11 與下一個選項卡數組(包含許多具有相同日期但不同時間的單元格)上的日期匹配,我希望它只拉出填充為橙色的單元格,這將被聲明為2020/08/11 7:45。 這可能嗎?
網站主持人對此評論進行了最小化
嗨,此代碼適用於 office 2016 及更高版本嗎?
網站主持人對此評論進行了最小化
不,它不返回顏色。
網站主持人對此評論進行了最小化
這段代碼工作正常,除了在輸入公式的單元格中,當它查找的單元格為空白時顯示 0 ,我的問題是如何讓它忽略空白單元格並防止公式所在的單元格輸入a 0,代碼中是否有一些地方可以輸入 =IFERROR 函數?
網站主持人對此評論進行了最小化
嗨凱爾,

我測試了這段代碼,當它查找的單元格為空白時,它不會顯示 0。
也許您可以將公式包含在 IF 函數中,如下所示,以防止返回結果 0。
=IF(B2="","",LookupKeepColor(E2,$A$1:$C$8,3))
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護