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

Cum să copiați formatarea sursă a celulei de căutare atunci când utilizați Vlookup în Excel?

În articolele anterioare, am vorbit despre păstrarea culorii de fundal atunci când valorile vlookup în Excel. Aici, în acest articol, vom introduce o metodă de copiere a tuturor formatărilor de celule ale celulei rezultate atunci când faceți Vlookup în Excel. Vă rugăm să faceți următoarele.

Copiați formatarea sursei atunci când utilizați Vlookup în Excel cu o funcție definită de utilizator


Copiați formatarea sursei atunci când utilizați Vlookup în Excel cu o funcție definită de utilizator

Să presupunem că aveți un tabel așa cum este prezentat mai jos. Acum trebuie să verificați dacă o valoare specificată (în coloana E) se află în coloana A și să returnați valoarea corespunzătoare cu formatarea în coloana C. Vă rugăm să faceți următoarele pentru a o atinge.

1. În foaia de lucru conține valoarea pe care doriți să o vizualizați, faceți clic dreapta pe fila foaie și selectați Afișați codul din meniul contextual. Vedeți captura de ecran:

2. În deschidere Microsoft Visual Basic pentru aplicații fereastra, copiați mai jos codul VBA în fereastra Cod.

Cod VBA 1: Vlookup și returnează valoarea cu formatarea

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. Apoi apasa Insera > Moduleși copiați codul VBA 2 de mai jos în fereastra Module.

Cod VBA 2: Vlookup și returnează valoarea cu formatarea

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. clic unelte > Referinte. Apoi verificați Microsoft Script Runtime cutie în Referințe - VBAProject căsuță de dialog. Vedeți captura de ecran:

5. apasă pe Alt + Q tastele pentru a ieși din Microsoft Visual Basic pentru aplicații fereastră.

6. Selectați o celulă necompletată adiacentă valorii de căutare, apoi introduceți formula =LookupKeepFormat(E2,$A$1:$C$8,3) în Formula Barului, apoi apăsați tasta Intrați cheie.

notițe: În formulă, E2 conține valoarea pe care o veți căuta, $ A $ 1: $ C $ 8 este intervalul tabelului și numărul 3 înseamnă că valoarea corespunzătoare pe care o veți returna o localizează în a treia coloană a tabelului. Vă rugăm să le schimbați după cum aveți nevoie.

7. Continuați să selectați prima celulă de rezultat, apoi glisați mânerul de umplere în jos pentru a obține toate rezultatele împreună cu formatarea lor, după cum a arătat imaginea de mai jos.


Legate de articole:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (42)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
îmi dă Eroare de compilare, eroare de sintaxă

vă rugăm să ajute
Acest comentariu a fost redus la minimum de moderatorul de pe site
O zi buna,
Codul a fost actualizat în articol. Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am primit și eroarea compilatorului.
Se corectează dacă modificați următoarea variabilă cu „”. Nu ';' În mijloc.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Scuze pentru greșeală, codul a fost actualizat în articol.
Greșeala " " ar trebui să fie două ghilimele " ". Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am primit aceeași eroare.

Va trebui să schimbați „ ” cu „” real, fără „;” după cum este indicat mai jos
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Scuze pentru greșeală, codul a fost actualizat în articol. Vă mulțumesc pentru partajarea.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Este grozav, mulțumesc! Singura problemă este că găsesc că funcționează bine dacă caut în aceeași foaie, dar nu o pot face să funcționeze când încerc să fac o căutare într-o foaie separată la datele sursă. Va continua sa incerce
Acest comentariu a fost redus la minimum de moderatorul de pe site
Julia, corectează aceste rânduri:
în funcția LookupKeepFormat:
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address & "|" & LookupRng.Parent.Name

în Sub Worksheet_Change:
Foi de calcul(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Copy
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hei Hugo,


Am aceeași problemă ca Julia. Nu merge pe alte foi. Ați putea ajuta la scrierea codului pentru întreaga funcție și sub foaia de lucru? Nu sunt sigur unde să înlocuiesc/inserez 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


multumesc in schimb
Acest comentariu a fost redus la minimum de moderatorul de pe site
Apreciez foarte mult continuarea lui Hugo!
Din nefericire, ca și Vi, sunt prea începător pentru a afla unde să inserez corecțiile de cod sugerate...

Multumesc inca o data, o zi buna :)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună


Am încercat să folosesc codul, dar primesc eroarea din imaginea atașată. Orice ajutor va fi foarte apreciat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Scuze pentru greșeală, codul a fost actualizat în articol. Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Nu primesc erori și efectuează căutarea, dar deoarece valoarea mea de căutare este pe altă foaie de lucru (un scenariu mai probabil), nu extrage formatarea. Există o modificare a codului pe care o pot face pentru asta? (Fii foarte specific cu privire la locul în care trebuie să meargă schimbarea, deoarece sunt un novice în codificare) Mulțumesc! Sunt încântat să adaug această funcție la una dintre foile mele de calcul!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, aveți noroc la această întrebare, cum putem face ca formatarea să fie căutată pe foi?
Acest comentariu a fost redus la minimum de moderatorul de pe site
De asemenea, caută modificarea.
Acest comentariu a fost redus la minimum de moderatorul de pe site
De asemenea, dacă adaug formula dvs. ca parte a unei declarații „Dacă” (vezi mai jos), aceasta formatează celula așa cum dorește LOL (sau cel puțin așa pare. O celulă, textul a devenit umbrit și aldin, cu un chenar de sus pe celula; altă celulă, textul centrat)


=IF($F19 = "", "",LookupKeepFormat(F19,'Articol #s'!$A$1:$M$1226,2))
Acest comentariu a fost redus la minimum de moderatorul de pe site
L-am încercat pe acesta și pe cel care trage doar fundalul de culoare și primesc aceeași eroare. Eroare de compilare: Nume ambiguu detectat. Dau clic pe OK și evidențiază xDic. Orice sugestii? Nu sunt foarte familiarizat cu toate acestea, așa că vă rugăm să ajutați/explicați :) mulțumesc anticipat
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Jeni,
Nu uitați să activați opțiunea Microsoft Script Runtime, așa cum este menționat la pasul 4.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna ziua. Am creat o foaie de calcul goală și am duplicat exemplul dvs. în Excel 2013, dar continuă să primești o eroare de compilare: Eroare de sintaxă și Dim I As Long este evidențiat. Este ceva ce îmi lipsește? Mi-ar plăcea să lucrez asta. Mulțumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Laura,
Nu uitați să activați opțiunea Microsoft Script Runtime, așa cum este menționat la pasul 4.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, am folosit codul de mai sus în Excel 2010 fără probleme până în prezent. Cu toate acestea, am fost recent actualizat la Office 2016 și acum codul blochează Excel de fiecare dată când încerc să completez mai mult de un rând. Din păcate, nu îmi dă o altă eroare decât „Microsoft Excel a încetat să funcționeze”. Mă întrebam dacă ați întâlnit această problemă anterior și dacă trebuie să fac ceva pentru ca aceasta să funcționeze în 2016. Mulțumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Leigh,
Codul funcționează bine în Excel 2016. Încercăm să facem upgrade la codul pentru a rezolva problema. Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, mulțumesc pentru cod. Nu primesc niciun mesaj de eroare, dar formula funcționează doar așa cum ar face o căutare normală. Puteti ajuta va rog? Mulțumesc pentru timpul acordat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hei

Am exact aceeași problemă, v-ați dat seama cum să o rezolvați?

Multumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut, am primit eroarea "Eroare de compilare: Nume ambigios detectat: xDic
Acest comentariu a fost redus la minimum de moderatorul de pe site
salut, am primit eroarea "Eroare de compilare: Nume ambigios detectat: xDic
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, sunt nou în utilizarea VBA și am încercat să folosesc acest cod în foaia de calcul, dar formatarea textului din fila Rec2 nu ajunge la fila Rec atunci când este utilizată căutarea. Orice ajutor ar fi foarte apreciat. Multumesc Pat
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aici este fișierul și poza
Acest comentariu a fost redus la minimum de moderatorul de pe site
Primesc aceeași eroare de nume ambiguu - a reușit cineva să o rezolve?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Primesc aceeași eroare de nume ambiguu - a reușit cineva să o rezolve?
Nu există comentarii postate aici încă
Încărcați mai
Vă rugăm să lăsați comentariile dvs. în engleză
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL