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

Kako kopirati izvorno oblikovanje iskalne celice pri uporabi Vlookupa v Excelu?

V prejšnjih člankih smo govorili o ohranjanju barve ozadja pri vrednostih vlookup v Excelu. Tu v tem članku bomo predstavili način kopiranja celotnega oblikovanja celic nastale celice pri izvajanju Vlookupa v Excelu. Naredite naslednje.

Kopirajte oblikovanje vira, ko uporabljate Vlookup v Excelu z uporabniško določeno funkcijo


Kopirajte oblikovanje vira, ko uporabljate Vlookup v Excelu z uporabniško določeno funkcijo

Recimo, da imate tabelo, kot je prikazano na spodnji sliki zaslona. Zdaj morate preveriti, ali je določena vrednost (v stolpcu E) v stolpcu A, in vrniti ustrezno vrednost z oblikovanjem v stolpec C. Prosimo, storite naslednje, da jo dosežete.

1. Na delovnem listu vsebuje vrednost, ki jo želite pregledati, z desno miškino tipko kliknite zavihek lista in izberite Ogled kode iz kontekstnega menija. Oglejte si posnetek zaslona:

2. Na odprtju Microsoft Visual Basic za aplikacije okno, kopirajte spodnjo kodo VBA v okno Code.

Koda VBA 1: Vlookup in vrnjena vrednost z oblikovanjem

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. Nato kliknite Vstavi > Moduliin kopirajte spodnjo kodo VBA 2 v okno modula.

Koda VBA 2: Vlookup in vrnjena vrednost z oblikovanjem

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 Orodja > Reference. Nato preverite Izvajalni čas Microsoft Script polje v Reference - VBAProject pogovorno okno. Oglejte si posnetek zaslona:

5. Pritisnite druga + Q tipke za izhod iz Microsoft Visual Basic za aplikacije okno.

6. Izberite prazno celico ob iskalni vrednosti in vnesite formulo =LookupKeepFormat(E2,$A$1:$C$8,3) v Formula Barin nato pritisnite Vnesite ključ.

Opombe: V formuli, E2 vsebuje vrednost, ki jo boste iskali, 1 A $ 8: XNUMX C $ je obseg tabele in število 3 pomeni, da se ustrezna vrednost, ki jo boste vrnili, poišče v tretjem stolpcu tabele. Prosimo, spremenite jih po potrebi.

7. Nadaljujte z izbiro prve celice z rezultati in nato povlecite ročico za polnjenje navzdol, da dobite vse rezultate skupaj z njihovim oblikovanjem, kot je prikazano spodaj.


Sorodni članki:


Najboljša orodja za pisarniško produktivnost

Kutools za Excel rešuje večino vaših težav in poveča vašo produktivnost za 80%

  • Ponovna uporaba: Hitro vstavite zapletene formule, grafikoni in vse, kar ste že uporabljali; Šifriraj celice z geslom; Ustvari poštni seznam in pošiljanje e-pošte ...
  • Vrstica Super Formula (enostavno urejanje več vrstic besedila in formule); Bralna postavitev (enostavno branje in urejanje velikega števila celic); Prilepite v filtrirani obseg...
  • Združi celice / vrstice / stolpce brez izgube podatkov; Vsebina razdeljenih celic; Združi podvojene vrstice / stolpce... prepreči podvojene celice; Primerjaj obsege...
  • Izberite Duplicate ali Unique Vrstice; Izberite prazne vrstice (vse celice so prazne); Super Find in Fuzzy Find v mnogih delovnih zvezkih; Naključna izbira ...
  • Natančna kopija Več celic brez spreminjanja sklica formule; Samodejno ustvarjanje referenc na več listov; Vstavi oznake, Potrditvena polja in še več ...
  • Izvleček besedila, Dodaj besedilo, Odstrani po položaju, Odstrani presledek; Ustvari in natisni vmesne seštevke strani Pretvarjanje med vsebino celic in komentarji...
  • Super filter (shranite in uporabite sheme filtrov za druge liste); Napredno razvrščanje glede na mesec / teden / dan, pogostost in drugo; Poseben filter s krepko, ležeče ...
  • Združite delovne zvezke in delovne liste; Spoji tabele na podlagi ključnih stolpcev; Razdelite podatke na več listov; Paketna pretvorba xls, xlsx in PDF...
  • Več kot 300 zmogljivih funkcij. Podpira Office / Excel 2007-2021 in 365. Podpira vse jezike. Enostavna uvedba v vašem podjetju ali organizaciji. 30-dnevna brezplačna preizkusna različica vseh funkcij. 60-dnevna garancija vračila denarja.
zavihek kte 201905

Kartica Office prinaša vmesnik z zavihki v Office in poenostavi vaše delo

  • Omogočite urejanje in branje z zavihki v Wordu, Excelu, PowerPointu, Publisher, Access, Visio in Project.
  • Odprite in ustvarite več dokumentov v novih zavihkih istega okna in ne v novih oknih.
  • Poveča vašo produktivnost za 50%in vsak dan zmanjša na stotine klikov miške za vas!
dno pisarniške mize
Komentarji (42)
Ocene še ni. Bodite prvi in ​​ocenite!
Ta komentar je moderator na spletnem mestu minimiziral
mi daje napako pri prevajanju, napako v sintaksi

prosim pomagajte
Ta komentar je moderator na spletnem mestu minimiziral
Dober dan,
Koda je bila posodobljena v članku. Hvala za vaš komentar.
Ta komentar je moderator na spletnem mestu minimiziral
Dobil sem tudi napako prevajalnika.
Popravi se, če naslednjo spremenljivko spremenite z dejanskim "". Ne ';' v sredini.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Oprostite za napako, koda je bila posodobljena v članku.
Napaka " " bi morala biti dva narekovaja " ". Hvala za vaš komentar.
Ta komentar je moderator na spletnem mestu minimiziral
Dobil sem isto napako.

Spremeniti boste morali " " za dejanski "', brez ';' kot je navedeno spodaj
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Oprostite za napako, koda je bila posodobljena v članku. Hvala za delitev.
Ta komentar je moderator na spletnem mestu minimiziral
To je super, hvala! Edina težava je, da se mi zdi, da deluje dobro, če iščem na istem listu, vendar ne morem delovati, ko poskušam na ločenem listu poiskati izvorne podatke. Še naprej se bom trudil
Ta komentar je moderator na spletnem mestu minimiziral
Julia, popravi te vrstice:
v funkciji 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)).Kopiraj
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Hugo,


Imam isti problem kot Julia. Na drugih listih ne deluje. Ali lahko pomagate napisati kodo za celotno funkcijo in poddelovni list? Ne vem, kje naj zamenjam/vstavim 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)).Kopiraj


hvala v zameno
Ta komentar je moderator na spletnem mestu minimiziral
Zelo cenim nadaljevanje Huga!
Na žalost sem tako kot Vi tudi jaz prevelik začetnik, da bi ugotovil, kam vstaviti predlagane popravke kode ...

Še enkrat hvala, lep dan :)
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo


Poskušal sem uporabiti kodo, vendar dobivam napako na priloženi sliki. Vsaka pomoč bo zelo cenjena.
Ta komentar je moderator na spletnem mestu minimiziral
Hi,
Oprostite za napako, koda je bila posodobljena v članku. Hvala za vaš komentar.
Ta komentar je moderator na spletnem mestu minimiziral
Hi,

Ne dobim nobenih napak in opravi iskanje, a ker je moja iskalna vrednost na drugem delovnem listu (verjetnejši scenarij), ne potegne oblikovanja. Ali lahko za to prilagodim kodo? (Bodite zelo natančni glede tega, kam mora iti sprememba, ker sem novinec v kodiranju) Hvala! Z veseljem dodam to funkcijo v eno od svojih preglednic!!
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, nekaj sreče pri tem vprašanju, kako lahko dosežemo, da se oblikovanje poišče po listih?
Ta komentar je moderator na spletnem mestu minimiziral
Prav tako išče prilagoditev.
Ta komentar je moderator na spletnem mestu minimiziral
Poleg tega, če dodam vašo formulo kot del stavka "Če" (glejte spodaj), oblikuje celico, kakor hoče LOL (ali se vsaj zdi tako. V eni celici je besedilo postalo zasenčeno in krepko z zgornjim robom na celica; druga celica, besedilo na sredini)


=IF($F19 = "", "",LookupKeepFormat(F19,'Element #s'!$A$1:$M$1226,2))
Ta komentar je moderator na spletnem mestu minimiziral
Poskusil sem tega in tistega, ki potegne samo barvno ozadje, in dobivam isto napako. Napaka pri prevajanju: zaznano dvoumno ime. Kliknem V redu in označi xDic. Kakšen predlog? Nisem dobro seznanjen z vsem tem, zato prosim za pomoč/razlago :) hvala vnaprej
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Jeni,
Ne pozabite omogočiti možnosti Microsoft Script Runtime, kot je omenjeno v 4. koraku.
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo. Ustvaril sem prazno preglednico in podvojil vaš primer v Excelu 2013, vendar se še vedno pojavlja napaka prevajanja: sintaksna napaka in Dim I As Long je označeno. Je kaj, kar pogrešam? Rad bi, da to deluje. Hvala vam.
Ta komentar je moderator na spletnem mestu minimiziral
Zdravo Laura,
Ne pozabite omogočiti možnosti Microsoft Script Runtime, kot je omenjeno v 4. koraku.
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, zgornjo kodo do danes uporabljam v Excelu 2010 brez težav. Vendar sem bil pred kratkim nadgrajen na Office 2016 in zdaj koda zruši Excel vsakič, ko poskušam izpolniti več kot eno vrstico. Na žalost mi ne daje druge napake kot "Microsoft Excel je prenehal delovati". Zanima me, ali ste že naleteli na to težavo in ali moram kaj narediti, da bo delovala v letu 2016. Hvala!
Ta komentar je moderator na spletnem mestu minimiziral
Živjo Leigh,
Koda dobro deluje v mojem Excelu 2016. Poskušamo nadgraditi kodo, da bi rešili težavo. Hvala za vaš komentar.
Ta komentar je moderator na spletnem mestu minimiziral
Pozdravljeni, hvala za kodo. Ne dobim nobenega sporočila o napaki, vendar formula deluje samo kot običajen vpogled. Ali lahko prosim pomagate? Hvala za vaš čas.
Ta komentar je moderator na spletnem mestu minimiziral
Živijo

Imam popolnoma enako težavo, ste ugotovili, kako jo rešiti?

Hvala!
Ta komentar je moderator na spletnem mestu minimiziral
živjo, pojavila se je napaka "napaka pri prevajanju: zaznano dvoumno ime: xDic
Ta komentar je moderator na spletnem mestu minimiziral
živjo, pojavila se je napaka "napaka pri prevajanju: zaznano dvoumno ime: xDic
Ta komentar je moderator na spletnem mestu minimiziral
Živjo, prvič uporabljam VBA in sem poskusil uporabiti to kodo v svoji preglednici, vendar se oblikovanje besedila na zavihku Rec2 ne prikaže na zavihku Rec, ko je uporabljeno iskanje. Vsaka pomoč bi bila zelo cenjena. Hvala Pat
Ta komentar je moderator na spletnem mestu minimiziral
Tukaj je datoteka in slika
Ta komentar je moderator na spletnem mestu minimiziral
Dobim isto napako dvoumnega imena - jo je komu uspelo rešiti?
Ta komentar je moderator na spletnem mestu minimiziral
Dobim isto napako dvoumnega imena - jo je komu uspelo rešiti?
Tu še ni objavljenih komentarjev
Obremenitev Več
Pustite vaše komentarje
Objava kot gost
×
Ocenite to objavo:
0   Znaki
Predlagane lokacije

Sledi nam

Copyright © 2009 - www.extendoffice.com. | Vse pravice pridržane. Poganja ga ExtendOffice. | Kazalo
Microsoft in logotip Office sta blagovni znamki ali registrirani blagovni znamki družbe Microsoft Corporation v ZDA in / ali drugih državah.
Zaščiteno s Sectigo SSL