Перейти к основному содержанию

Как автоматически связать цвет ячейки с другим в Excel?

Автор: Силувия Последнее изменение: 2020 июля 06 г.

Знаете ли вы, используя Microsoft Excel, как автоматически связать цвет ячейки с другим? Эта статья покажет вам, как этого добиться.

Автоматически связывать цвет ячейки с другим с помощью кода VBA


Автоматически связывать цвет ячейки с другим с помощью кода VBA

Предположим, вы хотите связать цвет заливки ячейки A1 с C1, при изменении цвета заливки A1 цвет C1 автоматически изменится на тот же. Пожалуйста, сделайте следующее.

1. Щелкните правой кнопкой мыши вкладку листа, в которой необходимо связать цвет ячейки с другим цветом, а затем щелкните Просмотреть код из контекстного меню.

2. В дебюте Microsoft Visual Basic для приложений окна, скопируйте и вставьте приведенный ниже код VBA в Code окно.

Код VBA: автоматическая привязка цвета ячейки к другому в Excel

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

Внимание: вы можете изменить ссылку на ячейки в коде по своему усмотрению.

3. Продолжайте нажимать другой + Q ключи одновременно, чтобы закрыть Microsoft Visual Basic для приложений окно.

С этого момента при изменении цвета заливки ячейки A1 цвет заливки ячейки C1 будет автоматически изменен на тот же цвет.

Лучшие инструменты для офисной работы

🤖 Kutools AI Помощник: Революционный анализ данных на основе: Интеллектуальное исполнение   |  Генерировать код  |  Создание пользовательских формул  |  Анализ данных и создание диаграмм  |  Вызов функций Kutools...
Популярные опции: Найдите, выделите или определите дубликаты   |  Удалить пустые строки   |  Объедините столбцы или ячейки без потери данных   |   Раунд без формулы ...
Супер поиск: Множественный критерий VLookup    VLookup с несколькими значениями  |   VLookup по нескольким листам   |   Нечеткий поиск ....
Расширенный раскрывающийся список: Быстрое создание раскрывающегося списка   |  Зависимый раскрывающийся список   |  Выпадающий список с множественным выбором ....
Менеджер столбцов: Добавить определенное количество столбцов  |  Переместить столбцы  |  Переключить статус видимости скрытых столбцов  |  Сравнить диапазоны и столбцы ...
Рекомендуемые функции: Сетка Фокус   |  Просмотр дизайна   |   Большой Формулный Бар    Менеджер книг и листов   |  Библиотека ресурсов (Авто текст)   |  Выбор даты   |  Комбинировать листы   |  Шифровать/дешифровать ячейки    Отправлять электронные письма по списку   |  Суперфильтр   |   Специальный фильтр (фильтровать жирным шрифтом/курсивом/зачеркиванием...) ...
15 лучших наборов инструментов12 Текст Инструменты (Добавить текст, Удалить символы, ...)   |   50+ График Тип (Диаграмма Ганта, ...)   |   40+ Практических Формулы (Рассчитать возраст по дню рождения, ...)   |   19 Вносимые Инструменты (Вставить QR-код, Вставить изображение из пути, ...)   |   12 Конверсия Инструменты (Числа в слова, Конверсия валюты, ...)   |   7 Слияние и разделение Инструменты (Расширенные ряды комбинирования, Разделить клетки, ...)   |   ... и более

Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени.  Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...

Описание


Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
Comments (57)
Rated 4.5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Hi
I used your code in my excel spread sheet and it worked perfectly when I changed the cell values to represent my spread sheet.

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


What I need the code to do is to continue this function for the rest of the work book.
Example
when I change the cell colour in H4151 (the next cell below the cell written in the macro above) I want AA4151 to change colour as well and so on and so on..........how do I rewrite the macro to include all the cells below H4150 and AA4150.
Thanks in advance

Neil
This comment was minimized by the moderator on the site
Hi There,

Thank you for posting VBA code it has helped alot, but now I now have a sheet "Invoice Report" that I colour code for each job in column H1:H100, I require the fill colour to copy to Columns G1:G100 and I1:I100.

Can anyone help assist
This comment was minimized by the moderator on the site
Hi Gemma,
The following VBA code can help.
Note: After changing the fill color of a cell, you need to double-click the cell for the code to take effect.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20230915
    Dim cell As Range
    If Not Intersect(Target, Me.Range("H1:H100")) Is Nothing Then
        For Each cell In Target
            If cell.Row <= 100 Then
                Me.Cells(cell.Row, "G").Interior.Color = cell.Interior.Color
                Me.Cells(cell.Row, "I").Interior.Color = cell.Interior.Color
            End If
        Next cell
    End If
End Sub
This comment was minimized by the moderator on the site
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("G41")) Is Nothing Then
'Update fill color of cell C5 in "Blanko VGL" worksheet
Worksheets("Blanko VGL").Range("C5").Interior.Color = Me.Range("G41").Interior.Color
End If
End Sub

Dear Crystal, i have done some formatting, since yesterday and changed the cells...but it does not work...

the first code in the first sheet does work but this one does not show reaction..can you double check please?

Once this is working i need to copy and paste the same code for each cell right?
This comment was minimized by the moderator on the site
Hi Anna,

Sorry for the mistake. Please try the following VBA code.
Remember:
1) Please add the VBA code to the sheet code window of the worksheet "Blanko PL".
2) After changing the fill color of G42, you need to double click on this cell and press Enter to make the code take effect.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20230602
If Not Intersect(Target, Me.Range("G42")) Is Nothing Then
Dim XSheet As Worksheet
Set XSheet = ThisWorkbook.Worksheets("Blanko VGL")
Dim XCell As Range
Set XCell = XSheet.Range("C" & Target.Row - 35 + (Target.Row > 42))
XCell.Interior.Color = Me.Range("G42").Interior.Color
End If
End Sub
This comment was minimized by the moderator on the site
Hi Guys. Thanks a lot for VBA interior color support!

i need this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
End Sub

This code is perfect!

But i have one Color in Sheet1
Sheet name is: Blanko PL
Cell: G42

I want the format color in G42 reflect in my sheet2
Sheetname: Blanko VGL
cell: C7

i want a code that any time i change the color in Sheet 1 in row 42 then i want to see this color ini sheet 2 in row 7

it is a number/price comparission. and i am selecting prices in Sheet 1.

Sheet 2 is my overview of my selected top pics.

And i need this code to continue because
G42 sheet 1 shoudl be linked with C7sheet2
I42 sheet1 should be linked with E7sheet2
K42 sheet1 should be linked with G7sheet2
M42 sheet1 should be linked with I7sheet2
O42 sheet1 should be linked with K7sheet2
and so on...

then it continues in the ROW below
G90 sheet 1 shoudl be linked with C8sheet2
I90 sheet1 should be linked with E8sheet2
K90 sheet1 should be linked with G8sheet2
M90 sheet1 should be linked with I8sheet2
O90 sheet1 should be linked with K8sheet2
and so on...

i believe i need only this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
End Sub

but i need to change Me.Range("C1").Interior.Color to Sheet2!

and then i need to either single code each linked cell?

or can i even do it by row?

I hope my Q is clear? please help me and share VBA solution.

Big thank you
This comment was minimized by the moderator on the site
Hi Anna,

Here's the VBA code that links the fill color of cell G42 in a worksheet named "Blanko PL" to cell C7 in another worksheet named "Blanko VGL":

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("G42")) Is Nothing Then
        'Update fill color of cell C7 in "Blanko VGL" worksheet
        Worksheets("Blanko VGL").Range("C7").Interior.Color = Me.Range("G42").Interior.Color
    End If
End Sub

Sorry I can only help with this task. I have tried but can't handle the other cells in the same row.
Note: Please add the VBA code to the code window of the worksheet "Blanko PL". After changing the fill color of G42, you need to double click it and press Enter, or modify any cell in the worksheet directly to make the code take effect.
This comment was minimized by the moderator on the site
Ciao,
è possibile assegnare questo codice VBA ad un pulsante per farlo eseguire?
This comment was minimized by the moderator on the site
Hi Dear. sadly didnt take

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("G41")) Is Nothing Then
'Update fill color of cell C5 in "Blanko VGL" worksheet
Worksheets("Blanko VGL").Range("C5").Interior.Color = Me.Range("G41").Interior.Color
End If
End Sub

Dear Crystal, i have done some formatting, since yesterday and changed the cells...but it does not work...

the first code in the first sheet does work but this one does not show reaction..can you double check please?

Once this is working i need to copy and paste the same code for each cell right?
This comment was minimized by the moderator on the site
Olá bom dia, eu queria alterar um range de cores de colunas e linhas numa mesma sheet (exemplo de K6:Q66 para D6:J66).
Alguém consegue me informar o código VBA, por favor?
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Hi Francislane,
Sorry I don't quite understand what you mean. Can you upload a screenshot of what you are trying to do?
This comment was minimized by the moderator on the site
Hi all, anyone can help me with the same case with esad
This comment was minimized by the moderator on the site
I have found success using this line of code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCRg As Range
Dim xStrAddress As String
Dim xFNum As Integer
xStrAddress = "Sheet2!$A$1:$A$10"
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("$A$1:$A$10")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
End Sub

I would like to be able to use one range to influence several others within one section of code. I.E., if I change a color in $A$1:$A$10, it changes the color in $C$10:$C$19, $D$21:$D$30, and $F$10:$F$19. Is this possible? Thank you.
This comment was minimized by the moderator on the site
Aqui la tiene en ingles


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRg As Range
Dim xCRg As Range
Dim xStrAddress As String
Dim xFNum As Integer
xStrAddress = ("Hoja2!A1")
Set xRg = Application.Range(xStrAddress)
Set xCRg = Me.Range("A1")
On Error Resume Next
For xFNum = 1 To xRg.Count
xRg.Item(xFNum).Interior.Color = xCRg.Item(xFNum).Interior.Color
Next
End Sub
This comment was minimized by the moderator on the site
Hi I wonder if you can help me please
I have a spreadsheet that has team members (17 of them) name in Row 2
In column H we would allocate a task to a team member
In column T we have the data to show what stage the team member is at for this task ( green/ Amber /Red)
What I would like to do is bring the colour for the task from col T to Col H with the name we would have entered

Any help would be greatly appreciated
This comment was minimized by the moderator on the site
Hi Ann,
Would you mind providing a screenshot of your data? Sorry for the inconvenience.
This comment was minimized by the moderator on the site
As per attached
The team names are in row 2 (R to AD)
Each row under the team name relates to the task in Col D
What I would like is when a name is entered in Col L it colours that cell with the colour from the team members col on that row
e.g. in Col L enter Emma it looks at Emma in W1 and brings over Green from W2. if it was Paula is would look at Paula in T1 and bring over amber from T2 etc
The name entered would still remain as example in L2 & 3

Thanks for your help
Not sure how to attaché screenshot or a FILE I can email it
This comment was minimized by the moderator on the site
Hi Ann,
I have tried some methods and still can't solve your problem. Sorry for the inconvenience.
This comment was minimized by the moderator on the site
Thanks for trying
This comment was minimized by the moderator on the site
Hi all,

My issue is that my home page (1st sheet) contains a summary of information provided in the following sheets. All the relevant cells have been formatted to reflect the value of their corresponding cells in the other sheets.

so for example, My cell homepage cell F7 is already formatted so it copies the value of the corresponding cell in source sheet:
=quarter1!B15

Now, what i would really want is for the cells on my home page to also match the color i manually select for their corresponding (source) cell in another sheet. Is this possible using VBA coding?

I got the below code from another site but it only works if the cells are on the same sheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Range("C1").Interior.Color = Me.Range("A1").Interior.Color
End Sub

Is there a way i can tweak this code to refer to a cell on another sheet in the same workbook?

Thank you so much for your help!
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations