Loncat ke daftar isi utama

Bagaimana cara menyalin pemformatan sumber dari sel pencarian saat menggunakan Vlookup di Excel?

Di artikel sebelumnya, kita telah berbicara tentang menjaga warna latar belakang saat nilai vlookup di Excel. Di sini, di artikel ini, kami akan memperkenalkan metode menyalin semua pemformatan sel dari sel yang dihasilkan saat melakukan Vlookup di Excel. Silakan lakukan sebagai berikut.

Salin pemformatan sumber saat menggunakan Vlookup di Excel dengan fungsi yang ditentukan pengguna


Salin pemformatan sumber saat menggunakan Vlookup di Excel dengan fungsi yang ditentukan pengguna

Misalkan Anda memiliki tabel seperti gambar di bawah ini. Sekarang Anda perlu memeriksa apakah nilai yang ditentukan (di kolom E) ada di kolom A dan mengembalikan nilai yang sesuai dengan pemformatan di kolom C. Lakukan hal berikut untuk mencapainya.

1. Di lembar kerja berisi nilai yang ingin Anda vlookup, klik kanan tab lembar dan pilih Lihat kode dari menu konteks. Lihat tangkapan layar:

2. Dalam pembukaan Microsoft Visual Basic untuk Aplikasi jendela, harap salin kode VBA di bawah ini ke jendela Kode.

Kode VBA 1: Vlookup dan mengembalikan nilai dengan pemformatan

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. Lalu klik Menyisipkan > Modul, dan salin kode VBA 2 di bawah ini ke jendela Modul.

Kode VBA 2: Vlookup dan mengembalikan nilai dengan pemformatan

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. klik Tools > Referensi. Kemudian periksa Waktu Proses Skrip Microsoft kotak di Referensi - VBAProject kotak dialog. Lihat tangkapan layar:

5. tekan lain + Q kunci untuk keluar dari Microsoft Visual Basic untuk Aplikasi jendela.

6. Pilih sel kosong yang berdekatan dengan nilai pencarian, lalu masukkan rumus =LookupKeepFormat(E2,$A$1:$C$8,3) ke dalam Formula Bar, lalu tekan Enter kunci.

Note: Dalam rumusnya, E2 berisi nilai yang akan Anda cari, $ A $ 1: $ C $ 8 adalah rentang tabel, dan angka 3 berarti bahwa nilai yang sesuai yang akan Anda kembalikan terletak di kolom ketiga tabel. Harap ubah sesuai kebutuhan Anda.

7. Tetap memilih sel hasil pertama, dan kemudian seret Fill Handle ke bawah untuk mendapatkan semua hasil bersama dengan pemformatannya seperti yang ditunjukkan gambar di bawah ini.


Artikel terkait:

Alat Produktivitas Kantor Terbaik

Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria    VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar    Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel    Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

tab kte 201905


Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
Comments (43)
No ratings yet. Be the first to rate!
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?
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
This comment was minimized by the moderator on the site
This code only works when data is in same sheet.
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.
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.
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...
This comment was minimized by the moderator on the site
Please provide details
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?
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.
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
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?
This comment was minimized by the moderator on the site
I'm getting an error
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?
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
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations