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

Як скопіювати вихідне форматування комірки пошуку під час використання Vlookup в Excel?

У попередніх статтях ми говорили про збереження кольору фону при значенні vlookup в Excel. Тут, у цій статті, ми збираємось представити метод копіювання всього форматування комірок отриманої комірки при виконанні Vlookup в Excel. Будь ласка, виконайте наступне.

Скопіюйте форматування вихідного коду під час використання Vlookup в Excel із визначеною користувачем функцією


Скопіюйте форматування вихідного коду під час використання Vlookup в Excel із визначеною користувачем функцією


Припустимо, у вас є таблиця, як показано на знімку екрана. Тепер вам потрібно перевірити, чи вказане значення (у стовпці E) є у стовпці A, і повернути відповідне значення з форматуванням у стовпці C. Будь ласка, виконайте наступні дії, щоб його досягти.

1. На робочому аркуші міститься значення, яке потрібно переглянути, клацніть правою кнопкою миші вкладку аркуша та виберіть Переглянути код з контекстного меню. Дивіться знімок екрана:

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

Код VBA 1: пошук і повернення значення з форматуванням

Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20211203
    Dim I As Long
    Dim xKeys As Long
    Dim xDicStr As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    xKeys = UBound(xDic.Keys)
    If xKeys >= 0 Then
        For I = 0 To UBound(xDic.Keys)
            xDicStr = xDic.Items(I)
            If xDicStr <> "" Then
                Set xRg = Application.Range(xDicStr)
                xRg.Copy
                Range(xDic.Keys(I)).PasteSpecial xlPasteFormats
            Else
                Range(xDic.Keys(I)).Interior.Color = xlNone
            End If
        Next
        Set xDic = Nothing
    End If
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
End Sub

3. Then click Insert > Module, and copy the below VBA code 2 into the Module window.

VBA code 2: Vlookup and return value with formatting

Public xDic As New Dictionary
'Update by Extendoffice 20211203
Function LookupKeepFormat(ByRef FndValue, ByRef LookupRng As Range, ByRef xCol As Long)
    Dim xFindCell As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xFindCell = LookupRng.Find(FndValue, , xlValues, xlWhole)
    If xFindCell Is Nothing Then
        LookupKeepFormat = " "
        xDic.Add Application.Caller.Address, " "
    Else
        LookupKeepFormat = xFindCell.Offset(0, xCol - 1).Value
        xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address(External:=True)
    End If
    Application.ScreenUpdating = True
End Function

4. Click Tools > References. Then check the Microsoft Script Runtime box in the References – VBAProject dialog box. See screenshot:

5. Press the Alt + Q keys to exit the Microsoft Visual Basic for Applications window.

6. Select a blank cell adjacent to the lookup value, and then enter formula =LookupKeepFormat(E2,$A$1:$C$8,3) into the Formula Bar, and then press the Enter key.

Note: In the formula, E2 contains the value you will lookup, $A$1:$C$8 is the table range, and number 3 means that the corresponding value you will return locates in the third column of the table. Please change them as you need.

7. Keep selecting the first result cell, and then drag the Fill Handle down to get all results along with their formatting as below screenshot showed.


Related articles:


The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
officetab bottom
Comments (42)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
it give me Compile Error ,Syntax error

please help
This comment was minimized by the moderator on the site
Good Day,
The code has been updated in the artcle. Thank you for your comment.
This comment was minimized by the moderator on the site
I also got the compiler error.
It gets corrected if you change the following variable with actual "". No ';' in the middle.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
This comment was minimized by the moderator on the site
Hi,
Sorry for the mistake, the code has been updated in the article.
The mistake " " should be two quotation marks " ". Thank you for your comment.
This comment was minimized by the moderator on the site
I got the same error.

You will have to change the " " for actual "', without ';' as indicated below
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
This comment was minimized by the moderator on the site
Hi,
Sorry for the mistake, the code has been updated in the article. Thank you for sharing.
This comment was minimized by the moderator on the site
This is great, thank you! The only problem is, I find it works fine if I'm looking up in the same sheet, but can't get it to work when I'm trying to do a lookup in a separate sheet to the source data. Will keep trying
This comment was minimized by the moderator on the site
Julia, correct this lines:
in Function LookupKeepFormat:
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address & "|" & LookupRng.Parent.Name

in Sub Worksheet_Change:
Sheets(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Copy
This comment was minimized by the moderator on the site
Hey Hugo,


I have the same problem as Julia. It doesn't work on other sheets. Could you help write code for the whole function and sub worksheet? I am not sure where to replace/insert xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address & "|" & LookupRng.Parent.Nam and Sheets(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Copy


thanks in return
This comment was minimized by the moderator on the site
Greatly appreciate the follow-up Hugo!
Unfortunately like Vi, I am too much of a novice to work out where to insert your suggested code fixes...

Thanks again, have a great day :)
This comment was minimized by the moderator on the site
Hi There


I have tried to use the code however I am getting the error in the attached pic. Any assisting will be greatly appreciated.
This comment was minimized by the moderator on the site
Hi,
Sorry for the mistake, the code has been updated in the article. Thank you for your comment.
This comment was minimized by the moderator on the site
Hi,

I get no errors and it does the lookup, but because my lookup value is on another worksheet (a more likely scenario), it doesn't pull the formatting. Is there a tweak to the code that I can make for that? (Be very specific as to where the change needs to go as I'm a coding novice) Thank you! I'm excited to add this feature to one of my spreadsheets!!
This comment was minimized by the moderator on the site
Hi, any luck on this question, how can we get the formatting to be looked up across sheets?
This comment was minimized by the moderator on the site
Also seeking the tweak.
This comment was minimized by the moderator on the site
Also, if I add your formula as part of an "If" statement (see below), it formats the cell however it wants LOL (or at least it seems so. One cell, the text went shadowed and bold with a top border on the cell; another cell, the text centered)


=IF($F19 = "", "",LookupKeepFormat(F19,'Item #s'!$A$1:$M$1226,2))
This comment was minimized by the moderator on the site
I tried this one and the the one that pulls just the color background and am getting the same error. Compile error: Ambiguous name detected. I click OK and it highlights xDic. Any suggestions? I'm not super familiar with all of this so please help/explain :) thanks in advance
This comment was minimized by the moderator on the site
Hi Jeni,
Don't forget to enable the Microsoft Script Runtime option as mentioned in step 4.
This comment was minimized by the moderator on the site
Hello. I created a blank spreadsheet and duplicated your example in Excel 2013, but keep getting a Compile error: Syntax error and Dim I As Long is highlighted. Is there something I'm missing? I would love to get this working. Thank you.
This comment was minimized by the moderator on the site
Hi Laura,
Don't forget to enable the Microsoft Script Runtime option as mentioned in step 4.
This comment was minimized by the moderator on the site
Hello, I've been using the above code in Excel 2010 with no problems to date. However, I was recently upgraded to Office 2016 and now the code crashes Excel every time I try to fill down more than one row. Unfortunately, it is not giving me an error other than "Microsoft Excel has stopped working". I was wondering if you have come across this issue previously, and if there is something I need to do to make it work in 2016. Thanks!
This comment was minimized by the moderator on the site
Hi Leigh,
The code works well in my Excel 2016. We are trying to upgrad the code to solve the problem. Thank you for your comment.
This comment was minimized by the moderator on the site
Hello, Thanks for the code. I do not get any error message but the formula only works as a normal vlookup would. Could you please assist? Thanks for your time.
This comment was minimized by the moderator on the site
Hello

I have exactly the same issue, did you figure out how to solve it?

Thanks!
This comment was minimized by the moderator on the site
hi i got the error "compile Error: Ambigious name detected: xDic
This comment was minimized by the moderator on the site
hi i got the error "compile Error: Ambigious name detected: xDic
This comment was minimized by the moderator on the site
HI, I am new to using VBA and tried using this code in my spreadsheet, but the text formatting on the Rec2 tab doesn't come over to Rec tab when lookup is used. Any help would be greatly appreciated. Thanks Pat
This comment was minimized by the moderator on the site
Here is the file and pic
This comment was minimized by the moderator on the site
I get the same Ambiguous name error - has anyone managed to solve it ?
This comment was minimized by the moderator on the site
I get the same Ambiguous name error - has anyone managed to solve it ?
There are no comments posted here yet
Load More
Leave your comments
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations