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

Hvordan kopieres kildeformatering af opslagscellen, når man bruger Vlookup i Excel?

I de tidligere artikler har vi talt om at holde baggrundsfarve, når vlookup-værdier i Excel. Her i denne artikel vil vi introducere en metode til at kopiere al celleformatering af den resulterende celle, når du laver Vlookup i Excel. Gør som følger.

Kopier kildeformatering, når du bruger Vlookup i Excel med en brugerdefineret funktion


Kopier kildeformatering, når du bruger Vlookup i Excel med en brugerdefineret funktion

Antag at du har en tabel som vist nedenstående skærmbillede. Nu skal du kontrollere, om en specificeret værdi (i kolonne E) er i kolonne A og returnere tilsvarende værdi med formatering i kolonne C. Gør som følger for at opnå det.

1. I regnearket indeholder den værdi, du vil oplyse, skal du højreklikke på arkfanen og vælge Vis kode fra genvejsmenuen. Se skærmbillede:

2. I åbningen Microsoft Visual Basic til applikationer vindue, skal du kopiere nedenstående VBA-kode til kodevinduet.

VBA-kode 1: Vlookup- og returværdi med formatering

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. Klik derefter på indsatte > Moduler, og kopier nedenstående VBA-kode 2 til modulvinduet.

VBA-kode 2: Vlookup- og returværdi med formatering

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 Værktøj > Referencer. Kontroller derefter Microsoft Script Runtime boks i Referencer - VBAProject dialog boks. Se skærmbillede:

5. Tryk på andre + Q taster for at afslutte Microsoft Visual Basic til applikationer vindue.

6. Vælg en tom celle ved siden af ​​opslagsværdien, og indtast derefter formlen =LookupKeepFormat(E2,$A$1:$C$8,3) ind i Formel Bar, og tryk derefter på Indtast nøgle.

Bemærk: I formlen E2 indeholder den værdi, du vil slå op, $ A $ 1: $ C $ 8 er tabelområdet og antallet 3 betyder, at den tilsvarende værdi, du returnerer, finder i den tredje kolonne i tabellen. Skift dem, som du har brug for.

7. Bliv ved med at vælge den første resultatcelle, og træk derefter udfyldningshåndtaget ned for at få alle resultater sammen med deres formatering, som nedenstående skærmbillede viste.


Relaterede artikler:


De bedste Office-produktivitetsværktøjer

Kutools til Excel løser de fleste af dine problemer og øger din produktivitet med 80%

  • Genbruge: Indsæt hurtigt komplekse formler, diagrammer og alt, hvad du har brugt før; Krypter celler med adgangskode Opret postliste og send e-mails ...
  • Super formel bar (let redigere flere linjer med tekst og formel); Læsning Layout (let at læse og redigere et stort antal celler); Indsæt til filtreret rækkevidde...
  • Flet celler / rækker / kolonner uden at miste data; Split celler indhold; Kombiner duplikerede rækker / kolonner... Forhindre duplikerede celler; Sammenlign områder...
  • Vælg Duplicate eller Unique Rækker; Vælg tomme rækker (alle celler er tomme); Super Find og Fuzzy Find i mange arbejdsbøger; Tilfældig valg ...
  • Præcis kopi Flere celler uden at ændre formelreference; Auto Opret referencer til flere ark; Indsæt kugler, Afkrydsningsfelter og mere ...
  • Uddrag tekst, Tilføj tekst, Fjern efter position, Fjern mellemrum; Opret og udskriv personsøgningssubtotaler; Konverter mellem celler indhold og kommentarer...
  • Superfilter (gem og anvend filterskemaer på andre ark); Avanceret sortering efter måned / uge / dag, hyppighed og mere; Specielt filter af fed, kursiv ...
  • Kombiner arbejdsbøger og arbejdsark; Fletabeller baseret på nøglekolonner; Opdel data i flere ark; Batch Konverter xls, xlsx og PDF...
  • Mere end 300 kraftfulde funktioner. Understøtter Office / Excel 2007-2021 og 365. Understøtter alle sprog. Nem implementering i din virksomhed eller organisation. Fuld funktioner 30-dages gratis prøveperiode. 60 dages pengene tilbage garanti.
kte-fane 201905

Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere

  • Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
  • Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
  • Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
officetab bund
Sorter kommentarer efter
Kommentarer (42)
Ingen vurderinger endnu. Vær den første til at bedømme!
Denne kommentar blev minimeret af moderatoren på webstedet
det giver mig kompileringsfejl, syntaksfejl

behage hjælp
Denne kommentar blev minimeret af moderatoren på webstedet
Good Day,
Koden er blevet opdateret i artcle. Tak for din kommentar.
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg fik også kompileringsfejlen.
Det bliver rettet, hvis du ændrer følgende variabel med faktisk "". Nej ';' i midten.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Beklager fejlen, koden er blevet opdateret i artiklen.
Fejlen " " skal være to anførselstegn " ". Tak for din kommentar.
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg fik samme fejl.

Du bliver nødt til at ændre " " for faktisk "' uden ';' som angivet nedenfor
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Beklager fejlen, koden er blevet opdateret i artiklen. Tak fordi du deler.
Denne kommentar blev minimeret af moderatoren på webstedet
Det er fantastisk, tak! Det eneste problem er, at jeg synes, det virker fint, hvis jeg slår op i det samme ark, men kan ikke få det til at virke, når jeg forsøger at lave et opslag i et separat ark til kildedataene. Vil blive ved med at prøve
Denne kommentar blev minimeret af moderatoren på webstedet
Julia, ret disse linjer:
i Function LookupKeepFormat:
xDic.Add Application.Caller.Address, xFindCell.Offset(0, xCol - 1).Address & "|" & LookupRng.Parent.Name

i Sub Worksheet_Change:
Sheets(Split(xDic.Items(I), "|")(1)).Range(Split(xDic.Items(I), "|")(0)).Kopi
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Hugo,


Jeg har samme problem som Julia. Det virker ikke på andre ark. Kan du hjælpe med at skrive kode til hele funktionen og underregnearket? Jeg er ikke sikker på, hvor jeg skal erstatte/indsætte 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)).Kopi


tak til gengæld
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg sætter stor pris på opfølgningen Hugo!
Desværre ligesom Vi er jeg for meget nybegynder til at finde ud af, hvor jeg skal indsætte dine foreslåede koderettelser...

Tak igen, hav en god dag :)
Denne kommentar blev minimeret af moderatoren på webstedet
Hej


Jeg har prøvet at bruge koden, men jeg får fejlen på det vedhæftede billede. Enhver hjælp vil blive meget værdsat.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,
Beklager fejlen, koden er blevet opdateret i artiklen. Tak for din kommentar.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej,

Jeg får ingen fejl, og den udfører opslag, men fordi min opslagsværdi er på et andet regneark (et mere sandsynligt scenarie), trækker det ikke formateringen. Er der en tweak til koden, som jeg kan lave til det? (Vær meget specifik med hensyn til, hvor ændringen skal gå, da jeg er nybegynder i kodning) Tak! Jeg er spændt på at tilføje denne funktion til et af mine regneark!!
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, held med dette spørgsmål, hvordan kan vi få formateringen til at blive slået op på tværs af ark?
Denne kommentar blev minimeret af moderatoren på webstedet
Søger også tweaken.
Denne kommentar blev minimeret af moderatoren på webstedet
Desuden, hvis jeg tilføjer din formel som en del af en "Hvis"-sætning (se nedenfor), formaterer den cellen, som den vil LOL (eller i det mindste ser det ud til. En celle, teksten blev skygget og fed med en øverste kant på cellen; en anden celle, teksten centreret)


=IF($F19 = "", "",LookupKeepFormat(F19,'Vare #s'!$A$1:$M$1226,2))
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg prøvede denne og den, der kun trækker farvebaggrunden og får den samme fejl. Kompileringsfejl: Tvetydigt navn fundet. Jeg klikker på OK, og det fremhæver xDic. Nogen forslag? Jeg er ikke super bekendt med alt dette, så hjælp/forklar venligst :) på forhånd tak
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Jeni,
Glem ikke at aktivere indstillingen Microsoft Script Runtime som nævnt i trin 4.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej. Jeg oprettede et tomt regneark og duplikerede dit eksempel i Excel 2013, men bliver ved med at få en kompileringsfejl: Syntaksfejl og Dim I As Long er fremhævet. Er der noget jeg mangler? Jeg ville elske at få dette til at virke. Tak skal du have.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Laura,
Glem ikke at aktivere indstillingen Microsoft Script Runtime som nævnt i trin 4.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg har brugt ovenstående kode i Excel 2010 uden problemer til dato. Jeg blev dog for nylig opgraderet til Office 2016, og nu går koden ned i Excel, hver gang jeg forsøger at udfylde mere end én række. Desværre giver det mig ikke en anden fejl end "Microsoft Excel er holdt op med at virke". Jeg tænkte på, om du er stødt på dette problem tidligere, og om der er noget, jeg skal gøre for at få det til at fungere i 2016. Tak!
Denne kommentar blev minimeret af moderatoren på webstedet
Hej Leigh,
Koden fungerer godt i min Excel 2016. Vi forsøger at opgradere koden for at løse problemet. Tak for din kommentar.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, tak for koden. Jeg får ingen fejlmeddelelse, men formlen virker kun som en normal vlookup ville. Kan du venligst hjælpe? Tak for din tid.
Denne kommentar blev minimeret af moderatoren på webstedet
Hej

Jeg har præcis det samme problem, fandt du ud af hvordan du løser det?

Tak!
Denne kommentar blev minimeret af moderatoren på webstedet
hej jeg fik fejlen "compile Error: Ambigious name deected: xDic
Denne kommentar blev minimeret af moderatoren på webstedet
hej jeg fik fejlen "compile Error: Ambigious name deected: xDic
Denne kommentar blev minimeret af moderatoren på webstedet
Hej, jeg er ny til at bruge VBA og prøvede at bruge denne kode i mit regneark, men tekstformateringen på fanen Rec2 kommer ikke over til fanen Rec, når opslag bruges. Enhver hjælp ville være meget værdsat. Tak Pat
Denne kommentar blev minimeret af moderatoren på webstedet
Her er filen og billedet
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg får den samme tvetydige navnefejl - har nogen formået at løse det?
Denne kommentar blev minimeret af moderatoren på webstedet
Jeg får den samme tvetydige navnefejl - har nogen formået at løse det?
Der er endnu ingen kommentarer her
Load More
Efterlad dine kommentarer
Sender som gæst
×
Bedøm dette indlæg:
0   Tegn
Foreslåede steder

Følg os

Copyright © 2009 - www.extendoffice.com. | Alle rettigheder forbeholdes. Drevet af ExtendOffice. | | Sitemap
Microsoft og Office-logoet er varemærker eller registrerede varemærker tilhørende Microsoft Corporation i USA og / eller andre lande.
Beskyttet af Sectigo SSL