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

Hur kopierar man källformatering av uppslagscellen när man använder Vlookup i Excel?

I de tidigare artiklarna har vi pratat om att behålla bakgrundsfärg när vlookup-värden i Excel. Här i den här artikeln ska vi introducera en metod för att kopiera all cellformatering av den resulterande cellen när du gör Vlookup i Excel. Gör så här.

Kopiera källformatering när du använder Vlookup i Excel med en användardefinierad funktion


Kopiera källformatering när du använder Vlookup i Excel med en användardefinierad funktion

Antar att du har en tabell som visas nedan. Nu måste du kontrollera om ett angivet värde (i kolumn E) finns i kolumn A och returnera motsvarande värde med formatering i kolumn C. Gör så här för att uppnå det.

1. I kalkylbladet innehåller det värde du vill söka igenom, högerklicka på arkfliken och välj Visa kod från snabbmenyn. Se skärmdump:

2. I öppningen Microsoft Visual Basic för applikationer kopiera nedan VBA-kod till kodfönstret.

VBA-kod 1: Vlookup och returvärde 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. Klicka sedan Insert > Modulernaoch kopiera nedanstående VBA-kod 2 till modulfönstret.

VBA-kod 2: Vlookup och returvärde 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. klick verktyg > Referenser. Kontrollera sedan Microsoft Script Runtime ruta i Referenser - VBAProject dialog ruta. Se skärmdump:

5. tryck på andra + Q för att avsluta Microsoft Visual Basic för applikationer fönster.

6. Välj en tom cell intill uppslagsvärdet och ange sedan formeln =LookupKeepFormat(E2,$A$1:$C$8,3) i Formula Bar, och tryck sedan på ange nyckel.

Anmärkningar: I formeln, E2 innehåller det värde du ska slå upp, $ A $ 1: $ C $ 8 är tabellområdet och antalet 3 betyder att motsvarande värde du kommer att returnera lokaliseras i den tredje kolumnen i tabellen. Ändra dem efter behov.

7. Fortsätt att välja den första resultatcellen och dra sedan ner Fill Handle för att få alla resultat tillsammans med formateringen enligt nedanstående skärmdump.


Relaterade artiklar:


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (42)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
det ger mig kompileringsfel, syntaxfel

snälla hjälp
Denna kommentar minimerades av moderatoren på webbplatsen
God dag,
Koden har uppdaterats i artikeln. Tack för din kommentar.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag fick även kompilatorfelet.
Det korrigeras om du ändrar följande variabel med faktiska "". Nej ';' i mitten.
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Ursäkta misstaget, koden har uppdaterats i artikeln.
Felet " " ska vara två citattecken " ". Tack för din kommentar.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag fick samma fel.

Du måste ändra " " för faktiska "', utan ';' som anges nedan
LookupKeepFormat = " "
xDic.Add Application.Caller.Address, " "

LookupKeepFormat = ""
xDic.Add Application.Caller.Address ""
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Ursäkta misstaget, koden har uppdaterats i artikeln. Tack för att du delar.
Denna kommentar minimerades av moderatoren på webbplatsen
Det här är jättebra, tack! Det enda problemet är att jag tycker att det fungerar bra om jag letar upp i samma ark, men jag kan inte få det att fungera när jag försöker göra en uppslag i ett separat ark till källdata. Kommer att fortsätta försöka
Denna kommentar minimerades av moderatoren på webbplatsen
Julia, rätta följande rader:
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)).Kopiera
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Hugo,


Jag har samma problem som Julia. Det fungerar inte på andra ark. Kan du hjälpa till att skriva kod för hela funktionen och underkalkylbladet? Jag är inte säker på var jag ska ersätta/infoga 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)).Kopiera


tack i gengäld
Denna kommentar minimerades av moderatoren på webbplatsen
Uppskattar enormt uppföljningen Hugo!
Tyvärr, precis som Vi, är jag för mycket nybörjare för att ta reda på var jag ska infoga dina föreslagna kodfixar...

Tack igen, ha en bra dag :)
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå där


Jag har försökt använda koden men jag får felet i den bifogade bilden. All hjälp kommer att uppskattas mycket.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Ursäkta misstaget, koden har uppdaterats i artikeln. Tack för din kommentar.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,

Jag får inga fel och det gör uppslagningen, men eftersom mitt uppslagsvärde finns på ett annat kalkylblad (ett mer troligt scenario), drar den inte formateringen. Finns det någon justering av koden som jag kan göra för det? (Var mycket specifik om var förändringen måste gå eftersom jag är en nybörjare som kodar) Tack! Jag är glad att lägga till den här funktionen i ett av mina kalkylark!!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, lycka till med den här frågan, hur kan vi få formateringen att slås upp över arken?
Denna kommentar minimerades av moderatoren på webbplatsen
Letar också efter tweaken.
Denna kommentar minimerades av moderatoren på webbplatsen
Dessutom, om jag lägger till din formel som en del av en "Om"-sats (se nedan), formaterar den cellen hur den vill LOL (eller åtminstone verkar det så. En cell, texten blev skuggad och fet med en övre kant på cellen; en annan cell, texten centrerad)


=IF($F19 = "", "",LookupKeepFormat(F19,'Artikel #s'!$A$1:$M$1226,2)))
Denna kommentar minimerades av moderatoren på webbplatsen
Jag provade den här och den som bara drar bakgrundsfärgen och får samma fel. Kompileringsfel: Tvetydigt namn upptäcktes. Jag klickar på OK och det markerar xDic. Några förslag? Jag är inte superbekant med allt detta så snälla hjälp/förklara :) tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Jeni,
Glöm inte att aktivera alternativet Microsoft Script Runtime som nämnts i steg 4.
Denna kommentar minimerades av moderatoren på webbplatsen
Hallå. Jag skapade ett tomt kalkylblad och duplicerade ditt exempel i Excel 2013, men fortsätt att få ett kompileringsfel: Syntaxfel och Dim I As Long är markerat. Är det något jag saknar? Jag skulle älska att få det här att fungera. Tack.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Laura,
Glöm inte att aktivera alternativet Microsoft Script Runtime som nämnts i steg 4.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, jag har använt ovanstående kod i Excel 2010 utan problem hittills. Men jag uppgraderades nyligen till Office 2016 och nu kraschar koden Excel varje gång jag försöker fylla i mer än en rad. Tyvärr ger det mig inget annat fel än "Microsoft Excel har slutat fungera". Jag undrar om du har stött på det här problemet tidigare och om det är något jag behöver göra för att få det att fungera under 2016. Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Leigh,
Koden fungerar bra i min Excel 2016. Vi försöker uppgradera koden för att lösa problemet. Tack för din kommentar.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, tack för koden. Jag får inget felmeddelande men formeln fungerar bara som en vanlig vlookup skulle. Kan du hjälpa till? Tack för din tid.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej

Jag har exakt samma problem, kom du på hur du skulle lösa det?

Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
hej jag fick felet "compile Error: Ambigious name discovered: xDic
Denna kommentar minimerades av moderatoren på webbplatsen
hej jag fick felet "compile Error: Ambigious name discovered: xDic
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, Jag är ny på att använda VBA och försökte använda den här koden i mitt kalkylblad, men textformateringen på fliken Rec2 kommer inte över till fliken Rec när uppslag används. All hjälp skulle vara mycket uppskattad. Tack Pat
Denna kommentar minimerades av moderatoren på webbplatsen
Här är filen och bilden
Denna kommentar minimerades av moderatoren på webbplatsen
Jag får samma tvetydiga namnfel - har någon lyckats lösa det?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag får samma tvetydiga namnfel - har någon lyckats lösa det?
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL