可否同步两个单元格字体颜色背景色等

a0zhuxian

表1 根据表2 进行同步变化，比如表格2里我选择了杨乐乐，所以杨乐乐变成红色填充黄色字体了，希望表1里相同位置的课程单元格也变成这样的，就是 。可否用公式实现，不行的话VB可否实现，请大神帮忙编辑一下。主要想做个根据表2黄色填充里名字的变化，使得表1里相对应的科目进行变化

a0zhuxian

求帮助哈

shenjianrong163

楼主，有几个问题：
1.你应该发Excel Vba区的。
2.“表格2里选择了杨乐乐”，这个“杨乐乐”怎么选?是通过下拉框选择还是鼠标单击“杨乐乐”的单元格?
3.“红色填充黄色字体”是你选择了“杨乐乐”后自动生成的还是选择后自己设置的?

a0zhuxian

shenjianrong163 发表于 2021-3-10 22:06
楼主，有几个问题：
1.你应该发Excel Vba区的。
2.“表格2里选择了杨乐乐”，这个“杨乐乐”怎么选?是通 ...

第二个问题回答：我是想通过下拉菜单的，但是表格里没做的呢
第三个问题回答：自动生成的，与黄颜色填充色里名字相同的变成红色填充黄色字体
第一个问题回答：因为我不会VBA所以尽量想看看有没有公式的方法

weiyingde

请测试。行的话赏朵小花。
Private Sub Worksheet_Change(ByVal Target As Range)
Randomize
clr = Array(2, 3, 4, 5, 6, 7, 8, 9, 10)(Int(Rnd * 9))
ActiveSheet.Cells(3, "D").Interior.ColorIndex = clr
ActiveSheet.Cells(1, "L").Interior.ColorIndex = ActiveSheet.Cells(3, "D").Interior.ColorIndex
End Sub

shenjianrong163

a0zhuxian 发表于 2021-3-10 23:33
第二个问题回答：我是想通过下拉菜单的，但是表格里没做的呢
第三个问题回答：自动生成的，与黄颜色填充 ...

代码放Sheet2中：

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Address <> "$L$1" Then Exit Sub
   
3.     Dim i%, j%, d, k, arr
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     With Sheets("Sheet2")
   
6.         arr = Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row).Value
   
7.         For i = 2 To UBound(arr) Step 2
   
8.             For j = 1 To UBound(arr, 2)
   
9.                 d(arr(i, j)) = ""
   
10.             Next
    
11.         Next
    
12.         k = d.keys
    
13.         With .[L1].Validation
    
14.         .Delete
    
15.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(k, ",")
    
16.         End With
    
17.     End With
    
18.     d.RemoveAll
    
19. End Sub
    
20. 
    
21. Private Sub Worksheet_Change(ByVal Target As Range)
    
22.     If Target.Address <> "$L$1" Then Exit Sub
    
23.     With Sheets("Sheet2")
    
24.         Dim rng As Range
    
25.         .Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row).Interior.ColorIndex = xlNone
    
26.         .Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row).Font.ColorIndex = xlAutomatic
    
27.         With Sheets("Sheet1")
    
28.             .Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row).Interior.ColorIndex = xlNone
    
29.             .Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row).Font.ColorIndex = xlAutomatic
    
30.         End With
    
31.         For Each rng In .Range("B2:K" & .Cells(.Rows.Count, 2).End(xlUp).Row)
    
32.             If rng.Value = .[L1].Value Then
    
33.                 rng.Interior.ColorIndex = 3
    
34.                 rng.Font.ColorIndex = 6
    
35.                 With Sheets("Sheet1")
    
36.                     .Cells((rng.Row - 1) / 2 + 1, rng.Column).Interior.ColorIndex = 3
    
37.                     .Cells((rng.Row - 1) / 2 + 1, rng.Column).Font.ColorIndex = 6
    
38.                 End With
    
39.             End If
    
40.         Next
    
41.     End With
    
42. End Sub

复制代码

shenjianrong163

a0zhuxian 发表于 2021-3-10 23:33
第二个问题回答：我是想通过下拉菜单的，但是表格里没做的呢
第三个问题回答：自动生成的，与黄颜色填充 ...

附件供参考（vba代码已经生成数据有效性）：



工作簿1.rar (14.3 KB, 下载次数: 9)

2021-3-11 15:02 上传

点击文件名下载附件

sylun

试试如下文档，还是用条件格式设置
工作簿1A.rar (13.95 KB, 下载次数: 17)

2021-3-11 20:32 上传

点击文件名下载附件

a0zhuxian

weiyingde 发表于 2021-3-11 08:05
请测试。行的话赏朵小花。
Private Sub Worksheet_Change(ByVal Target As Range)
Randomize

没有变化啊

a0zhuxian

shenjianrong163 发表于 2021-3-11 15:01
代码放Sheet2中：

能将选人名的从sheet2移到sheet1里吗，sheet1 L1的位置就行