【原】Excel VBA 学校排课表冲突重复提示/自动设置部分区域重复值颜色

快速浏览

往期合集：【2023年3月】【2023年4月】【2023年5月】【2023年6月】【2023年7月】【2023年8月】

实用案例

|日期控件||简单的收发存|

|电子发票管理助手|

|电子发票登记系统(Access版)|

|Excel多种类型文件合并|

|Excel表格拆分神器|

|批量生成审计凭证抽查底稿|

|中医诊所收费系统(Excel版)|

|中医诊所收费系统(Access版)|

|收费管理系(Access改进版)|

收费使用项目

|财务管理系统|

内容提要

• 定义动态区域
• 设置重复单元格背景色

大家好，我是冷水泡茶，今天在EXCELHOME论坛上看到一个网友的求助贴，怎么解决同行同日重复值填充颜色问题？

他的表格是这样的：

表头是星期一到星期五，第二行是各个班级，第三行是课目，第4行往下是老师姓名，他的要求是同一天，同一行，科目相同则老师不能重复。

在前两天分享的【Excel VBA 学校老师监考考场自动按排】一文中，有检查冲突的操作，那个是纵向老师不能重复，跟今天这个有点类似。

我开始以为是同一天，同一行，老师不能重复，没想到科目不相同是可以重复的。我后来问了，他是这样的，有的老师兼其他科目，而不同的科目上课时段是不同的。

不管它，我们得按照别人的要求来做啊。

一开始，我想用条件格式来做，也想到前面我们分享过文章【Excel VBA 工作表突出显示行列高亮】，应该可以参考一下。不过，搞了半天，由于它有两个区域作为判断条件，条件格式的方法不太理想，最后只好放弃。

我们还是老老实实地通过循环判断，在某一天的所有单元格中，结合表头的科目，检查有没有重复的值，进而给它设置不同的颜色。

最关键的一点，如何确定当前输入老师姓名的单元格是属于哪一天的？如何取得这一天的所有单元格范围？

我们运用了一个“投机取巧”的方法，利用表头的合并单元格来确定一个区域，正好是某一天。

最后，总算是达成目标，分享给大家：

基本思路：

1、通过合并单元格的范围，确定一个区域。

2、把科目设置为一个区域rngSubject，任课老师设置为一个区域rng，他们大小相同。

3、循环rng，把它的每个单元格与rngSubject对应的单元格连成一个字符串，并与其他单元连成的字符串进行比较，如果有相等的，那么就是重复值，把rng相等的两个单元格设置成黄色。

VBA代码

在工作表里，Worksheet_Change工作表Change事件：

Private Sub Worksheet_Change(ByVal Target As Range)    Dim rng As Range, rngSubject As Range    Dim currCol As Integer, firstCol As Integer, lastCol As Integer    Dim keyWords As String    If Target.Cells.Count > 1 Then Exit Sub    If Target.Row > 3 And Target.Column > 2 Then           currCol = Target.Column        firstCol = Cells(1, currCol).MergeArea.Cells(1, 1).Column        lastCol = Cells(1, currCol).MergeArea.Columns.Count + firstCol - 1        Set rng = Range(Cells(Target.Row, firstCol), Cells(Target.Row, lastCol))        Set rngSubject = Range(Cells(3, firstCol), Cells(3, lastCol))        rng.Interior.Color = xlNone        For i = 1 To rng.Columns.Count            If rng.Cells(1, i) <> "" Then                keyWords = rng.Cells(1, i) & rngSubject.Cells(1, i)                For j = 1 To rng.Columns.Count                    If i <> j Then                        If keyWords = rng.Cells(1, j) & rngSubject.Cells(1, j) Then                            rng.Cells(1, j).Interior.Color = RGB(255, 255, 0)                            rng.Cells(1, i).Interior.Color = RGB(255, 255, 0)                        End If                    End If                Next            End If        Next    End IfEnd Sub

代码解析：

1、定义一些变量，Range对象等。

2、line5，如果选择了多个单元格，则退出过程，否则会出错。

3、line6，判断当前目标单元格的位置，在第二列，第三行以下。

4、line7~11，通过当前单元格，定位表头一个合并单元格，取得其第一个单元格和最后一个单位的列标，从而动态地定义需要设置格式的区域。

5、line12，把当前区域的单元格背景色设为无。

6、line13~25，循环rng的每个单元格，结合rngSubject查找重复值，并将它标上颜色。

来一个动画演示

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！

需要示例文件的朋友请稍微留意一下：

• 写文不易，分享免费，请关注、点赞、点在看、点广告、留言，如果不愿走上面的“流程”，打赏也行，万分感谢！