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

Jak kopírovat zdrojové formátování vyhledávací buňky při použití Vlookup v aplikaci Excel?

V předchozích článcích jsme hovořili o zachování barvy pozadí při hodnotách vlookup v aplikaci Excel. Zde v tomto článku představíme metodu kopírování veškerého formátování buněk výsledné buňky při provádění aplikace Vlookup v aplikaci Excel. Postupujte prosím následovně.

Zkopírujte formátování zdroje při použití aplikace Vlookup v aplikaci Excel s uživatelem definovanou funkcí


Zkopírujte formátování zdroje při použití aplikace Vlookup v aplikaci Excel s uživatelem definovanou funkcí

Předpokládejme, že máte tabulku uvedenou níže. Nyní musíte zkontrolovat, zda je zadaná hodnota (ve sloupci E) ve sloupci A, a vrátit odpovídající hodnotu s formátováním ve sloupci C. K dosažení toho prosím postupujte následovně.

1. V listu obsahuje hodnotu, kterou chcete vlookup, klepněte pravým tlačítkem na kartu listu a vyberte Zobrazit kód z kontextové nabídky. Viz snímek obrazovky:

2. V otvoru Microsoft Visual Basic pro aplikace zkopírujte níže uvedený kód VBA do okna Kód.

Kód VBA 1: Vlookup a návratová hodnota s formátováním

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. Pak klikněte na tlačítko Vložit > Modula zkopírujte níže uvedený kód VBA 2 do okna modulu.

Kód VBA 2: Vlookup a návratová hodnota s formátováním

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. cvaknutí Tools > Reference. Poté zkontrolujte Microsoft Script Runtime pole v Reference - VBAProject dialogové okno. Viz snímek obrazovky:

5. zmáčkni Další + Q klávesy pro opuštění Microsoft Visual Basic pro aplikace okno.

6. Vyberte prázdnou buňku sousedící s vyhledanou hodnotou a poté zadejte vzorec =LookupKeepFormat(E2,$A$1:$C$8,3) do Formula Bar, a poté stiskněte tlačítko vstoupit klíč.

Poznámka: Ve vzorci E2 obsahuje hodnotu, kterou vyhledáte, $ A $ 1: $ C $ 8 je rozsah tabulky a číslo 3 znamená, že odpovídající hodnota, kterou vrátíte, se najde ve třetím sloupci tabulky. Změňte je prosím podle potřeby.

7. Pokračujte ve výběru první buňky výsledků a poté přetáhněte rukojeť Vyplnit dolů, aby se zobrazily všechny výsledky spolu s jejich formátováním, jak je uvedeno níže.


Související články:


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2021 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
officetab dno
Komentáře (42)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
dává mi to chyba kompilace, chyba syntaxe

prosím pomozte
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Kód byl aktualizován v článku. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Také jsem dostal chybu kompilátoru.
Bude opraveno, pokud změníte následující proměnnou se skutečným "". Ne ';' uprostřed.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Omlouváme se za chybu, kód byl v článku aktualizován.
Chyba " " by měla být ve dvou uvozovkách " ". Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Mám stejnou chybu.

Budete muset změnit „ “ za skutečné „“, bez „;“ jak je uvedeno níže
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Omlouváme se za chybu, kód byl v článku aktualizován. Děkuji za sdílení.
Tento komentář byl moderátorem webu minimalizován
To je skvělé, děkuji! Jediný problém je, že to funguje dobře, pokud hledám ve stejném listu, ale nemůžu to spustit, když se pokouším vyhledat zdrojová data v samostatném listu. Bude se snažit dál
Tento komentář byl moderátorem webu minimalizován
Julie, opravte tyto řádky:
ve Function LookupKeepFormat:
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address & "|" & LookupRng.Parent.Name

v Sub Worksheet_Change:
Sheets(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Kopírovat
Tento komentář byl moderátorem webu minimalizován
Ahoj Hugo,


Mám stejný problém jako Julia. Na jiných listech to nefunguje. Mohl byste pomoci napsat kód pro celou funkci a dílčí list? Nejsem si jistý, kam nahradit/vložit 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)).Kopírovat


díky na oplátku
Tento komentář byl moderátorem webu minimalizován
Velmi oceňuji pokračování Hugo!
Bohužel jako Vi jsem příliš velký nováček na to, abych zjistil, kam vložit navrhované opravy kódu...

Ještě jednou děkuji, přeji hezký den :)
Tento komentář byl moderátorem webu minimalizován
Zdravím


Snažil jsem se použít kód, ale dostávám chybu v přiloženém obrázku. Jakákoli pomoc bude velmi oceněna.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Omlouváme se za chybu, kód byl v článku aktualizován. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,

Nezobrazují se žádné chyby a provádí vyhledávání, ale protože moje vyhledávací hodnota je na jiném listu (pravděpodobnější scénář), nevytáhne formátování. Existuje nějaká úprava kódu, kterou pro to mohu udělat? (Buďte velmi konkrétní, kam se změna musí ubírat, protože jsem v kódování nováček) Děkuji! Jsem nadšený, že mohu přidat tuto funkci do jedné z mých tabulek!!
Tento komentář byl moderátorem webu minimalizován
Ahoj, máte štěstí v této otázce, jak můžeme dosáhnout toho, aby bylo formátování vyhledáno na listech?
Tento komentář byl moderátorem webu minimalizován
Také hledá vyladění.
Tento komentář byl moderátorem webu minimalizován
Také, pokud přidám váš vzorec jako součást příkazu "If" (viz níže), naformátuje buňku, jak chce, LOL (nebo to alespoň vypadá. Jedna buňka, text byl stínovaný a tučný s horním okrajem buňku; další buňku, text na střed)


=IF($F19 = "", "",LookupKeepFormat(F19,'Položka #s'!$A$1:$M$1226,2))
Tento komentář byl moderátorem webu minimalizován
Zkoušel jsem tento a ten, který táhne pouze barevné pozadí a dostávám stejnou chybu. Chyba kompilace: Byl zjištěn nejednoznačný název. Kliknu na OK a zvýrazní se xDic. Nějaké návrhy? Nejsem moc obeznámen s tím vším, takže prosím o pomoc/vysvětlení :) předem děkuji
Tento komentář byl moderátorem webu minimalizován
Ahoj Jeni,
Nezapomeňte povolit možnost Microsoft Script Runtime, jak je uvedeno v kroku 4.
Tento komentář byl moderátorem webu minimalizován
Ahoj. Vytvořil jsem prázdnou tabulku a duplikoval jsem váš příklad v Excelu 2013, ale stále se zobrazuje chyba kompilace: Chyba syntaxe a zvýrazněno Dim I As Long. Je něco, co mi chybí? Rád bych, aby to fungovalo. Děkuji.
Tento komentář byl moderátorem webu minimalizován
Ahoj Laura,
Nezapomeňte povolit možnost Microsoft Script Runtime, jak je uvedeno v kroku 4.
Tento komentář byl moderátorem webu minimalizován
Dobrý den, výše uvedený kód jsem dosud bez problémů používal v Excelu 2010. Nedávno jsem však byl upgradován na Office 2016 a nyní kód havaruje Excel pokaždé, když se pokusím vyplnit více než jeden řádek. Bohužel mi to nedává jinou chybu než "Microsoft Excel přestal fungovat". Zajímalo by mě, zda jste se s tímto problémem setkali již dříve a zda existuje něco, co musím udělat, aby to v roce 2016 fungovalo. Díky!
Tento komentář byl moderátorem webu minimalizován
ahoj Leigh,
Kód funguje dobře v mém Excelu 2016. Snažíme se kód upgradovat, abychom problém vyřešili. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Dobrý den, děkuji za kód. Nezobrazuje se mi žádná chybová zpráva, ale vzorec funguje pouze jako normální vlookup. Mohl byste prosím pomoci? Díky za váš čas.
Tento komentář byl moderátorem webu minimalizován
Ahoj

Mám úplně stejný problém, přišel jsi na to, jak to vyřešit?

Díky!
Tento komentář byl moderátorem webu minimalizován
ahoj, dostal jsem chybu "Chyba kompilace: Zjištěno nejednoznačné jméno: xDic
Tento komentář byl moderátorem webu minimalizován
ahoj, dostal jsem chybu "Chyba kompilace: Zjištěno nejednoznačné jméno: xDic
Tento komentář byl moderátorem webu minimalizován
Ahoj, jsem nový v používání VBA a pokusil jsem se použít tento kód ve své tabulce, ale formátování textu na kartě Rec2 se při použití vyhledávání nepřepne na kartu Rec. Jakákoli pomoc by byla velmi oceněna. Díky Pat
Tento komentář byl moderátorem webu minimalizován
Zde je soubor a obrázek
Tento komentář byl moderátorem webu minimalizován
Dostávám stejnou chybu Nejednoznačné jméno - podařilo se to někomu vyřešit?
Tento komentář byl moderátorem webu minimalizován
Dostávám stejnou chybu Nejednoznačné jméno - podařilo se to někomu vyřešit?
Zatím zde nejsou žádné komentáře
Načíst další
Zanechte prosím své komentáře v angličtině
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění

Sociální sítě

Copyright © 2009 - www.extendoffice.com. | Všechna práva vyhrazena. Poháněno ExtendOffice. | |. | Sitemap
Microsoft a logo Office jsou ochranné známky nebo registrované ochranné známky společnosti Microsoft Corporation ve Spojených státech a / nebo jiných zemích.
Chráněno Sectigo SSL