Μετάβαση στο κύριο περιεχόμενο

Πώς να συνδέσετε αυτόματα ένα χρώμα κελιού με ένα άλλο στο Excel;

Κατά τη χρήση του Microsoft Excel, γνωρίζετε πώς να συνδέσετε αυτόματα ένα χρώμα κελιού με ένα άλλο; Αυτό το άρθρο θα σας δείξει τη μέθοδο για να το επιτύχετε.

Συνδέστε αυτόματα ένα χρώμα κελιού με ένα άλλο με τον κωδικό VBA


Συνδέστε αυτόματα ένα χρώμα κελιού με ένα άλλο με τον κωδικό VBA

Ας υποθέσουμε ότι θέλετε να συνδέσετε το χρώμα πλήρωσης του κελιού A1 με το C1, όταν αλλάζετε το χρώμα πλήρωσης του Α1, το χρώμα του C1 θα μετατραπεί στο ίδιο αυτόματα. Κάντε τα εξής:

1. Κάντε δεξί κλικ στην καρτέλα φύλλων που πρέπει να συνδέσετε ένα χρώμα κελιού με ένα άλλο και, στη συνέχεια, κάντε κλικ στο Προβολή κωδικού από το μενού με δεξί κλικ.

2. Στο άνοιγμα Microsoft Visual Basic για εφαρμογές παράθυρο, αντιγράψτε και επικολλήστε τον παρακάτω κώδικα VBA στο Κώδικας παράθυρο.

Κωδικός VBA: Αυτόματη σύνδεση χρώματος κελιού με άλλο στο Excel

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

Note: μπορείτε να αλλάξετε την αναφορά κελιών στον κώδικα όπως χρειάζεστε.

3. Προχωρήστε για να πατήσετε το άλλος + Q ταυτόχρονα για να κλείσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.

Από τώρα και στο εξής, όταν αλλάζετε το χρώμα πλήρωσης του κελιού A1, το χρώμα πλήρωσης του κελιού C1 θα αλλάζει αυτόματα στο ίδιο χρώμα.

Τα καλύτερα εργαλεία παραγωγικότητας γραφείου

🤖 Kutools AI Aide: Επανάσταση στην ανάλυση δεδομένων με βάση: Ευφυής Εκτέλεση   |  Δημιουργία κώδικα  |  Δημιουργία προσαρμοσμένων τύπων  |  Αναλύστε δεδομένα και δημιουργήστε γραφήματα  |  Επίκληση Λειτουργιών Kutools...
Δημοφιλή χαρακτηριστικά: Εύρεση, επισήμανση ή αναγνώριση διπλότυπων   |  Διαγραφή κενών γραμμών   |  Συνδυάστε στήλες ή κελιά χωρίς απώλεια δεδομένων   |   Γύρος χωρίς φόρμουλα ...
Σούπερ Αναζήτηση: VLookup πολλαπλών κριτηρίων    VLookup πολλαπλών τιμών  |   VLookup σε πολλά φύλλα   |   Ασαφής αναζήτηση ....
Σύνθετη αναπτυσσόμενη λίστα: Γρήγορη δημιουργία αναπτυσσόμενης λίστας   |  Εξαρτημένη αναπτυσσόμενη λίστα   |  Πολλαπλή αναπτυσσόμενη λίστα ....
Διαχειριστής στήλης: Προσθέστε έναν συγκεκριμένο αριθμό στηλών  |  Μετακίνηση στηλών  |  Εναλλαγή κατάστασης ορατότητας κρυφών στηλών  |  Συγκρίνετε εύρη και στήλες ...
Επιλεγμένα Χαρακτηριστικά: Εστίαση πλέγματος   |  Προβολή σχεδίου   |   Μεγάλη Formula Bar    Διαχείριση βιβλίου εργασίας & φύλλου   |  Βιβλιοθήκη πόρων (Αυτόματο κείμενο)   |  Επιλογή ημερομηνίας   |  Συνδυάστε φύλλα εργασίας   |  Κρυπτογράφηση/Αποκρυπτογράφηση κελιών    Αποστολή email ανά λίστα   |  Σούπερ φίλτρο   |   Ειδικό φίλτρο (φίλτρο με έντονη γραφή/πλάγια γραφή/διαγραφή...) ...
Κορυφαία 15 σύνολα εργαλείων12 Κείμενο Εργαλεία (Προσθήκη κειμένου, Κατάργηση χαρακτήρων, ...)   |   50 + Διάγραμμα Τύποι (Gantt διάγραμμα, ...)   |   40+ Πρακτικό ΜΑΘΗΜΑΤΙΚΟΙ τυποι (Υπολογίστε την ηλικία με βάση τα γενέθλια, ...)   |   19 Εισαγωγή Εργαλεία (Εισαγωγή κωδικού QR, Εισαγωγή εικόνας από το μονοπάτι, ...)   |   12 Μετατροπή Εργαλεία (Αριθμοί σε λέξεις, Μετατροπή Συναλλάγματος, ...)   |   7 Συγχώνευση & διαχωρισμός Εργαλεία (Σύνθετες σειρές συνδυασμού, Διαίρεση κελιών, ...)   |   ... κι αλλα

Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου.  Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...

Περιγραφή


Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη

  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 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