У попередніх статтях ми говорили про збереження кольору фону при значенні 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 Потім натисніть Insert > Модуліта скопіюйте наведений нижче код VBA 2 у вікно модуля.
Код VBA 2: пошук і повернення значення з форматуванням
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 Function4. клацання інструменти > посилання. Потім перевірте Виконання сценарію Microsoft коробка в Посилання - VBAProject діалогове вікно. Дивіться знімок екрана:
5 Натисніть кнопку інший + Q клавіші для виходу з Microsoft Visual Basic для додатків вікна.
6. Виберіть порожню комірку, поруч із значенням пошуку, а потім введіть формулу =LookupKeepFormat(E2,$A$1:$C$8,3) в Бар Формула, а потім натисніть вводити ключ
примітки: У формулі, E2 містить значення, яке ви будете шукати, $ A $ 1: $ C $ 8 - діапазон таблиці та номер 3 означає, що відповідне значення, яке ви повернете, знаходить у третьому стовпці таблиці. Будь ласка, змініть їх, як вам потрібно.
7. Продовжуйте обирати першу комірку результату, а потім перетягніть ручку заповнення вниз, щоб отримати всі результати разом із їх форматуванням, як показано на знімку екрана.
