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

Jak automaticky propojit barvu buňky s jinou v aplikaci Excel?

Víte při používání aplikace Microsoft Excel, jak automaticky propojit barvu buňky s jinou? Tento článek vám ukáže způsob, jak toho dosáhnout.

Automaticky propojte barvu buňky s jinou pomocí kódu VBA


Automaticky propojte barvu buňky s jinou pomocí kódu VBA

Předpokládejme, že chcete propojit barvu výplně buňky A1 s C1, při změně barvy výplně A1 se barva C1 automaticky změní na stejnou. Postupujte prosím následovně.

1. Klikněte pravým tlačítkem na kartu listu, kterou potřebujete k propojení barvy buňky s jinou, a poté klikněte Zobrazit kód z nabídky pravého tlačítka myši.

2. V otvoru Microsoft Visual Basic pro aplikace v okně zkopírujte a vložte níže uvedený kód VBA do Kód okno.

Kód VBA: Automatické propojení barvy buňky s jinou v aplikaci Excel

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
End Sub

Poznámka: můžete změnit odkaz na buňky v kódu, jak potřebujete.

3. Pokračujte stisknutím tlačítka Další + Q současně zavřete Microsoft Visual Basic pro aplikace okno.

Od této chvíle se při změně barvy výplně buňky A1 automaticky změní barva výplně buňky C1 na stejnou barvu.


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

Kutools pro Excel vyřeší většinu vašich problémů a zvýší vaši produktivitu
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é funkce
    . Podporuje Office/Excel
    2007-2019 a 365
    . Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Plné funkce
    30
    -denní zkušební verze zdarma. 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 tím
    50%
    a každý den vám sníží stovky kliknutí myší!
officetab dno
Komentáře (47)
Hodnocení 4.5 z 5 · 1 hodnocení:
Tento komentář byl moderátorem webu minimalizován
co mezi listy ve stejném sešitu - prosím o radu, jak se změní vzorec? dík!
Tento komentář byl moderátorem webu minimalizován
Skvělý tutoriál. Dík :) !!!!
Tento komentář byl moderátorem webu minimalizován
ano zajímalo by mě jak zrcadlit barvu na jiný list??? Mám vzorec v obou polích, ale chtěl bych, aby barva toho jednoho zrcadlila barvu na hlavní stránce, když se změní. tj.. List s datem školení je za 30 dní a pole se změní na červené; odpovídající pole na hlavní stránce, pole s "X" se také změní na červenou.
Tento komentář byl moderátorem webu minimalizován
Ahoj Jessica,
Co myslíš box? Textové pole?
Tento komentář byl moderátorem webu minimalizován
Existuje způsob, jak to udělat, pokud jsou dvě buňky v různých sešitech?
Tento komentář byl moderátorem webu minimalizován
Ahoj Dustine,
Nezvládne různé sešity. Děkuji za váš komentář.
Tento komentář byl moderátorem webu minimalizován
Viděl jsem tady nahoře ve vysvětlení, jak na jednu buňku, jak na pár buněk?
Tento komentář byl moderátorem webu minimalizován
Ahoj Rogerio,
Máte na mysli propojit barvu výplně buňky s více buňkami současně?
Tento komentář byl moderátorem webu minimalizován
y su el la celda A1 tiene un formato condicional ?
Tento komentář byl moderátorem webu minimalizován
Pokud buňky nejsou různé listy?
Tento komentář byl moderátorem webu minimalizován
Hi Mario,
Předpokládejme, že chcete propojit barvu buňky A1 v aktuálním listu s rozsahem B1:J19 v Listu2, použijte níže uvedený kód VBA. Po změně barvy výplně A1 klikněte na jinou buňku v aktuálním listu a aktivujte kód.

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xStrAddress jako řetězec
xStrAddress = "List2! $B$1:$J$19"
Nastavit xRg = Application.Range(xStrAddress)
xRg.Interior.Color = Me.Range("A1").Interior.Color
End Sub
Tento komentář byl moderátorem webu minimalizován
To fungovalo. Jak by to fungovalo, kdyby se A1 v Listu 1 změnilo na B1 v Listu2, ale také A2 v Listu1 se změnilo na B2 v Listu2?
Tento komentář byl moderátorem webu minimalizován
Ahoj Může mi někdo co nejdříve pomoci s výše uvedenou otázkou, nutně to potřebuji a dochází mi čas.
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Níže uvedený kód VBA vám může pomoci vyřešit problém. Děkuji za váš komentář.

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xStrAddress jako řetězec
xStrAddress = "List2! $B$1"
Nastavit xRg = Application.Range(xStrAddress)
xRg.Interior.Color = Me.Range("A1").Interior.Color
xStrAddress = "List2! $B$2"
Nastavit xRg = Application.Range(xStrAddress)
xRg.Interior.Color = Me.Range("A2").Interior.Color
xStrAddress = "List2! $B$3"
Nastavit xRg = Application.Range(xStrAddress)
xRg.Interior.Color = Me.Range("A3").Interior.Color
End Sub
Tento komentář byl moderátorem webu minimalizován
Не могли бы вы написать прям оригинальный код,без разъяснений,я новичобятуЉобетумобятупобобетупом
Tento komentář byl moderátorem webu minimalizován
Bohužel mi to nefungovalo. Zajímalo by mě, jestli je to tím, že původní buňka je seznam s pravidlem podmíněného formátování pro změnu barvy pozadí v závislosti na tom, jaká možnost je vybrána v seznamu.
Tento komentář byl moderátorem webu minimalizován
Ahoj Amanda,
Tento kód nefunguje pro barvu výplně přiřazenou pravidlem podmíněného formátování. Omluvám se za nepříjemnost.
Tento komentář byl moderátorem webu minimalizován
Je možné propojit barvu z jednoho rozsahu na jednom listu s jiným rozsahem stejné velikosti na jiném listu? Například mám střídavé barvy každých pár řádků a chci, aby se toto barevné schéma zkopírovalo na jiný list.
Tento komentář byl moderátorem webu minimalizován
Ahoj Charlesi,
Níže uvedený kód vám může udělat laskavost. Pokud chcete propojit barvu z rozsahu A1:A19 na Listu1 se stejným rozsahem "A1:A19" na Listu2, zkopírujte prosím kód do okna Kód Listu1, poté klikněte na libovolnou buňku na Listu1 pro aktivaci kódu. Doufám, že pomůžu. Děkuji za váš komentář.

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xStrAddress jako řetězec
xStrAddress = "List2! $A$1:$A$19"
Nastavit xRg = Application.Range(xStrAddress)
xRg.Interior.Color = Me.Range("A1:A19").Interior.Color
End Sub
Tento komentář byl moderátorem webu minimalizován
Dobrý den,
Zdá se, že tento kód funguje, pokud odkazuji na jednu buňku, ale pokud zadám rozsah, rozsah na listu 2 zčerná místo toho, aby se vyrovnal s barvou interiéru.

nějaké nápady, proč by se to mohlo stát?
Tento komentář byl moderátorem webu minimalizován
Ahoj Joey,
Promiň za tu chybu. Zkuste tento kód:

Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = "List2! $A$1:$A$10"
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("$A$1:$A$10")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub
Tento komentář byl moderátorem webu minimalizován
Ahoj Crystal,
Díky moc. Funguje perfektně!
Jsi úžasná! O_o
Tento komentář byl moderátorem webu minimalizován
Ahoj Crystal!
Jak vypadá stejný kód, když chci, aby se zkopíroval do Listu2 i Listu3 současně?
Tento komentář byl moderátorem webu minimalizován
Ahoj může někdo odpovědět na tuto otázku. Přesně o to se snažím a nemám štěstí.
Tento komentář byl moderátorem webu minimalizován
tohle mi nefunguje. Stále se mi zobrazuje chyba „chyba kompilace, zjištěn nejednoznačný název“....
Tento komentář byl moderátorem webu minimalizován
tohle mi nefunguje. může rozsah buněk není na obou listech stejný. můžete mi poradit, co dělat nebo jak upravit kód pls?
Tento komentář byl moderátorem webu minimalizován
Ahoj LG,
Existují dva řádky, které můžete upravit: rozsah "$A$1:$A$10" z osmého řádku a "List2! $A$1:$A$10" šestého řádku, což znamená, že propojíte barvu výplně rozsahu A1: A10 v listu (předpokládejme, že List1 a kód by měl být přidán do tohoto okna kódu listu) do stejného rozsahu v Sheet2.
Podle potřeby můžete zadat dva různé rozsahy. A ujistěte se, že název listu, který zadáte do šestého řádku, je existující název listu.
Tento komentář byl moderátorem webu minimalizován
Používám to k vytváření vzorů tkaní. Chtěl bych mít několik sad skupin, takže musím změnit pouze jednu buňku, abych viděl, co se stane v mém vzoru. Fungovalo to od buňky a1 do c1, ale když jsem se pokusil přidat novou sadu a2 do c1, ne. Možná to špatně chápu, ale zkopíroval jsem stejný vzorec pod prvním a změnil jsem odkazy na buňky. To je ten problém? Existuje jiný způsob?
Tento komentář byl moderátorem webu minimalizován
Tento pro mě fungoval při vkládání do druhého odkazu na list - ale musel jsem provést úpravu, níže ukážu úpravu, abyste viděli první verzi Crystal, pak moji s úpravou, která fungovala, když jsem místo toho potřeboval zahrnout dvě sady. jednoho. Toto je ta, kterou Crystal dala Joeymu poté, co řekl, že cílová vzdálenost zčernala, když to zkusil:
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = "List2! $A$1:$A$10"
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("$A$1:$A$10")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub
Můj mod, který fungoval tak, aby zahrnoval dvě sady (např. odkaz na různé sloupce nebo řádky nebo co máte), měl zahrnout tuto část:
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
po každém z mých "setů"
Takže bez úpravy vzorových sad, které dal Crystal, aby se od sebe lišily (což pravděpodobně bude vaše, pokud se snažíte odkazovat na různé řádky atd.), vypadalo by to takto:
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = "List2! $A$1:$A$10"
Nastavit xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("$A$1:$A$10") On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
xStrAddress = "List2! $A$1:$A$10"
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("$A$1:$A$10")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub

s řádky 6-8 a 13-15 jsou "sady" a řádky 9-12 a 16-19 jsou kód, který se musí opakovat po každé sadě.
Doufám, že to dává smysl, protože o tom nic nevím, jen jsem našel způsob, jak zkopírovat to, co zde bylo uvedeno, který fungoval. Když jsem poprvé zkusil mít dvě sady zapojením do kódu tak, jak je, první sada zčernala buňky a druhá sada fungovala a změnila cílové buňky na správnou barvu. Nakonec jsem přišel na to, že aby fungovala, každá sada potřebuje za sebou kód řádku 9-12. Tento mod umožnil (v mém případě) příslušným barvám přenést ze dvou různých sloupců na původním listu do odpovídajících buněk v daném rozsahu na cílovém listu.
Tento komentář byl moderátorem webu minimalizován
Jak propojím barvy buňky na základě hodnoty jiné buňky a barvy, které se mají automaticky propojit.

Příklad pevnosti.



Mám hodnotu listu 1 898 a na listu 2 hodnotu 898 a tato buňka je zbarvena růžově. Jak mohu propojit stejnou barvu, aby byla stejná, na základě vodítka je list 2, který má být spojen s listem 1 - takže může zobrazovat stejnou barvu. Ale byl by to rozsah; pomocí celého řádku, aby odpovídal jeho hodnotám, a poté propojit barvy.



Jakákoli pomoc je velmi ceněna
Tento komentář byl moderátorem webu minimalizován
Ahoj esade, mám s tebou momentálně stejný případ, budu rád, když se podělíš
Tento komentář byl moderátorem webu minimalizován
Hledám kopírování barev generovaných z podmíněně formátované tabulky do jiné tabulky - automaticky pomocí vzorce/funkce. Je to možné?
Tento komentář byl moderátorem webu minimalizován
Hy,
Chtěl bych, aby se při ruční změně barvy ve sloupci A list1 automaticky změnila barva ve sloupci A list2.
Prosím o pomoc. Děkuji
Tento komentář byl moderátorem webu minimalizován
Ahoj Ivano, vyzkoušejte prosím níže uvedený kód. Private Sub Worksheet_SelectionChange (ByVal Target As Range)
'aktualizováno uživatelem Extendoffice 20201127
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = "List2! $A$1:$A$100"
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("$A$1:$A$100")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub
Tento komentář byl moderátorem webu minimalizován
Ahoj buenas tardes. Como hacer que cuando seleccione una celda se active otra, y si selecciono otro cambie a otro celda con que este vinculada.Ejemplo: si alecciono A1 se active celda H20, y si doy otro clic se deactive. Se que seria mucho trabajo porque tendria que programar cada celda, pero no importa, es solo saber como hacerlo. Děkujeme vám za apoyo!
Tento komentář byl moderátorem webu minimalizován
ahoj výše uvedený kód fungoval, ale nebude fungovat vícekrát na jednom listu? 
Tento komentář byl moderátorem webu minimalizován
Zdravím všechny,

Můj problém je, že moje domovská stránka (1. list) obsahuje souhrn informací uvedených v následujících listech. Všechny příslušné buňky byly naformátovány tak, aby odrážely hodnotu jejich odpovídajících buněk v ostatních listech.

takže například buňka domovské stránky Moje buňka F7 je již naformátována, takže zkopíruje hodnotu odpovídající buňky ve zdrojovém listu:
=čtvrtletí1!B15

Nyní bych opravdu chtěl, aby buňky na mé domovské stránce také odpovídaly barvě, kterou ručně vyberu pro jejich odpovídající (zdrojovou) buňku na jiném listu. Je to možné pomocí kódování VBA?

Získal jsem níže uvedený kód z jiného webu, ale funguje to pouze v případě, že jsou buňky na stejném listu.
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
End Sub

Existuje způsob, jak mohu vyladit tento kód tak, aby odkazoval na buňku na jiném listu ve stejném sešitu?

Mockrát vám děkuji za vaši pomoc!
Tento komentář byl moderátorem webu minimalizován
Dobrý den, zajímalo by mě, jestli mi můžete pomoci
Mám tabulku se jménem členů týmu (17 z nich) v řádku 2
Ve sloupci H bychom přidělili úkol členovi týmu
Ve sloupci T máme data, která ukazují, v jaké fázi se člen týmu pro tento úkol nachází (zelená/jantarová/červená)
Chtěl bych přenést barvu úkolu ze sloupce T do sloupce H se jménem, ​​které bychom zadali

Jakákoli pomoc by byla velmi oceněna
Tento komentář byl moderátorem webu minimalizován
ahoj ann,
Nevadilo by vám poskytnout snímek obrazovky vašich dat? Omluvám se za nepříjemnost.
Tento komentář byl moderátorem webu minimalizován
Podle přiloženého
Názvy týmů jsou na řádku 2 (R až AD)
Každý řádek pod názvem týmu se vztahuje k úkolu v Col D
Co bych chtěl, je, když je jméno zadáno ve sloupci L, obarví tuto buňku barvou ze sloupce členů týmu na tomto řádku
např. v Col L zadejte Emmu, podívá se na Emmu v W1 a přivede Greena z W2. kdyby to byla Paula, podíval by se na Paulu v T1 a přinesl jantar z T2 atd
Zadaný název by stále zůstal jako příklad v L2 a 3

Děkujeme za vaši pomoc
Nejsem si jistý, jak připojit snímek obrazovky nebo SOUBOR, mohu jej poslat e-mailem
Tento komentář byl moderátorem webu minimalizován
ahoj ann,
Zkoušel jsem několik metod a stále nemohu vyřešit váš problém. Omluvám se za nepříjemnost.
Tento komentář byl moderátorem webu minimalizován
Díky za snahu
Tento komentář byl moderátorem webu minimalizován
Aqui la tiene en ingles


Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = ("Hoja2!A1")
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("A1")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub
Tento komentář byl moderátorem webu minimalizován
Našel jsem úspěch pomocí tohoto řádku kódu:
Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRg jako rozsah
Dim xCRg jako rozsah
Dim xStrAddress jako řetězec
Dim xFNum jako celé číslo
xStrAddress = "List2! $A$1:$A$10"
Nastavit xRg = Application.Range(xStrAddress)
Nastavit xCRg = Me.Range("$A$1:$A$10")
On Error Resume Next
Pro xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
další
End Sub

Chtěl bych mít možnost použít jeden rozsah k ovlivnění několika dalších v jedné části kódu. IE, pokud změním barvu v $A$1:$A$10, změní se barva v $C$10:$C$19, $D$21:$D$30 a $F$10:$F$19. Je to možné? Děkuji.
Tento komentář byl moderátorem webu minimalizován
Ahoj všichni, někdo mi může pomoci se stejným případem s esadem
Zatím zde nejsou žádné komentáře
Načíst další
Zanechat své připomínky
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