Bỏ qua nội dung chính

Làm cách nào để sao chép định dạng nguồn của ô tra cứu khi sử dụng Vlookup trong Excel?

Trong các bài trước, chúng ta đã nói về việc giữ màu nền khi các giá trị vlookup trong Excel. Ở đây trong bài viết này, chúng tôi sẽ giới thiệu một phương pháp sao chép tất cả định dạng ô của ô kết quả khi thực hiện Vlookup trong Excel. Hãy làm như sau.

Sao chép định dạng nguồn khi sử dụng Vlookup trong Excel với chức năng Do người dùng xác định

Sao chép định dạng nguồn khi sử dụng Vlookup trong Excel với chức năng Do người dùng xác định

Giả sử bạn có một bảng như hình minh họa bên dưới. Bây giờ bạn cần kiểm tra xem một giá trị được chỉ định (trong cột E) có nằm trong cột A hay không và trả về giá trị tương ứng với định dạng trong cột C. Hãy làm như sau để đạt được nó.

1. Trong trang tính có chứa giá trị bạn muốn vlookup, nhấp chuột phải vào tab trang tính và chọn Mã Chế độ xem từ menu ngữ cảnh. Xem ảnh chụp màn hình:

2. Trong phần mở đầu Microsoft Visual Basic cho các ứng dụng , vui lòng sao chép mã VBA bên dưới vào cửa sổ Mã.

Mã VBA 1: Vlookup và trả về giá trị với định dạng

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. Sau đó nhấn vào Chèn > Mô-đunvà sao chép mã VBA 2 bên dưới vào cửa sổ Mô-đun.

Mã VBA 2: Vlookup và trả về giá trị với định dạng

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. nhấp chuột CÔNG CỤ > dự án. Sau đó kiểm tra Thời gian chạy Microsoft Script hộp trong Tài liệu tham khảo - VBAProject hộp thoại. Xem ảnh chụp màn hình:

5. Nhấn nút Khác + Q chìa khóa để thoát khỏi Microsoft Visual Basic cho các ứng dụng cửa sổ.

6. Chọn một ô trống bên cạnh giá trị tra cứu, sau đó nhập công thức =LookupKeepFormat(E2,$A$1:$C$8,3) vào Thanh công thức, và sau đó nhấn đăng ký hạng mục thi Chìa khóa.

Chú thích: Trong công thức, E2 chứa giá trị bạn sẽ tra cứu, $ A $ 1: $ C $ 8 là phạm vi bảng và số 3 nghĩa là giá trị tương ứng bạn sẽ trả về nằm trong cột thứ ba của bảng. Vui lòng thay đổi chúng khi bạn cần.

7. Tiếp tục chọn ô kết quả đầu tiên, và sau đó kéo Fill Handle xuống để nhận tất cả các kết quả cùng với định dạng của chúng như ảnh chụp màn hình bên dưới.

Các bài liên quan:

Công cụ năng suất văn phòng tốt nhất

🤖 Trợ lý AI của Kutools: Cách mạng hóa việc phân tích dữ liệu dựa trên: Thực thi thông minh   |  Tạo mã  |  Tạo công thức tùy chỉnh  |  Phân tích dữ liệu và tạo biểu đồ  |  Gọi các hàm Kutools...
Các tính năng phổ biến: Tìm, đánh dấu hoặc xác định các bản sao   |  Xóa hàng trống   |  Kết hợp các cột hoặc ô mà không làm mất dữ liệu   |   Vòng không có công thức hữu ích. Cảm ơn !
Siêu tra cứu: Nhiều tiêu chí VLookup  |   VLookup Nhiều Giá Trị  |   VLookup trên nhiều trang tính   |   Tra cứu mờ ....
Danh sách thả xuống nâng cao: Tạo nhanh danh sách thả xuống   |  Danh sách thả xuống phụ thuộc   |  Danh sách thả xuống nhiều lựa chọn ....
Trình quản lý cột: Thêm một số cột cụ thể  |  Di chuyển cột  |  Chuyển đổi trạng thái hiển thị của các cột ẩn  |  So sánh dãy và cột hữu ích. Cảm ơn !
Các tính năng nổi bật: Tiêu điểm lưới   |  Chế độ xem thiết kế   |   Thanh công thức lớn   |  Trình quản lý sổ làm việc & trang tính   |  Thư viện tài nguyên (Văn bản tự động)   |  Bảng chọn ngày   |  Kết hợp các bảng tính   |  Mã hóa/Giải mã ô   |  Gửi email theo danh sách   |  Siêu lọc   |   Bộ lọc đặc biệt (lọc in đậm/nghiêng/gạch ngang...) ...
15 bộ công cụ hàng đầu:  12 bản văn CÔNG CỤ (thêm văn bản, Xóa ký tự,...)   |   50 + Biểu đồ Các loại (Biểu đồ Gantt,...)   |   40+ Thực tế Công thức (Tính tuổi dựa trên ngày sinh,...)   |   19 chèn CÔNG CỤ (Chèn mã QR, Chèn ảnh từ đường dẫn,...)   |   12 Chuyển đổi CÔNG CỤ (Số thành từ, Chuyển đổi tiền tệ,...)   |   7 Hợp nhất & Tách CÔNG CỤ (Các hàng kết hợp nâng cao, Chia ô,...)   |   ... và nhiều hơn nữa

Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian.  Bấm vào đây để có được tính năng bạn cần nhất...

Mô tả

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
Comments (44)
No ratings yet. Be the first to rate!
Dorina
Dorina
This comment was minimized by the moderator on the site
It seems to work but excel freezes from it and goes unresponsive. HELP!!!!
Reply
0
0
Kaila
Kaila
This comment was minimized by the moderator on the site
So - this macro works, but every time I use it my spreadsheet stops responding for roughly 3 minutes (even for one single line of data). Any tips?
Reply
0
0
slb
slb
This comment was minimized by the moderator on the site
Is there a way to use this on the same sheet with two different lookups. Ie. Lookup Column M in array A:B, return column B with formatting. Then Lookup in Column N in array C:D and return column D with formatting?
Ive got the first set working perfectly, and the second set wont work at all. No error, just most of the rows are blank
Reply
0
0
kirtiraj
kirtiraj
This comment was minimized by the moderator on the site
This code only works when data is in same sheet.
Reply
0
0
crystal
crystal     kirtiraj
This comment was minimized by the moderator on the site
Hi kirtiraj,To lookup values across worksheets and keep the formatting, you need to place the VBA code 1 in the code window of the result worksheet, and place the VBA code 2 in the Module code window.
Reply
Report
0
0
John
John
This comment was minimized by the moderator on the site
I get a compile error: "Expected: end of statement", with the word "New" highlighted in: "Public xDic As New Dictionary".
I'm not a developer, just trying to solve a problem in a long set of sheets. So thank you for the help.
Reply
0
0
M B
M B
This comment was minimized by the moderator on the site
HeyThe code does not work in Microsoft Excel 2019 (16.0.13929.20360) 64-bit Can provide details if asked...
Reply
0
0
ed
ed     M B
This comment was minimized by the moderator on the site
Please provide details
Reply
0
0
ABCD
ABCD
This comment was minimized by the moderator on the site
How to make this work if the value we are trying to look up sits in a different worksheet?
Reply
0
0
crystal
crystal     ABCD
This comment was minimized by the moderator on the site
Hi,
To lookup values across worksheets and keep the formatting, you need to place the VBA code 1 in the code window of the result worksheet, and place the VBA code 2 in the Module code window.
Reply
Report
1
0
FrenchToastKB
FrenchToastKB     crystal
This comment was minimized by the moderator on the site
That's Bad***!
Thanks for the coding and the tip on how to make the formula work across separate worksheets, friend.
However the coding should modified for the Subworksheet_Change for the one below:
Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20230328
Dim I As Long
Dim xKeys As Long
Dim xDicStr As String
On Error Resume Next
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.EnableEvents = 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
Application.EnableEvents = True
End Sub


If you combine the coding I wrote below for the Result worksheet and the coding provided here in the Module, it will work when using separate worksheets.
You'll thank me later!
Cheers
Reply
Report
0
0
Jeff
Jeff
This comment was minimized by the moderator on the site
So, I got this to work. However, how I'm using it is I have the lookupkeepformat formula already entered in multiple rows. I then enter a letter (A-J) in column A and this letter tells the lookup formula which data I want. After it pulls the data, the cursor ends up in the cell where it finished entering the lookup data. How can I have the cursor return to column A?
Reply
0
0
Jeff
Jeff
This comment was minimized by the moderator on the site
I'm getting an error
Reply
0
0
Rah2153
Rah2153
This comment was minimized by the moderator on the site
I am adding these modules to my PERSONAL.XLSB file. I have Outlook 2016. And when I use this user-defined function, my excel doesn't crash or give an error. But it does not pull in the format of the source cell. It only pulls in the value. Since this function is located in the PERSONAL.XLSB file, my formula looks like this;=PERSONAL.xlsb!LookupKeepFormat(E2,$A$1:$C$8,3)
I had copied the code into 2 modules as directed, but this just doesn't work. Any ideas why?
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations