重点内容
适用版本
桌面版通用(Excel 365 / 2021 / 2019 等)。
完整代码
Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer
Set rangeToUse = Selection
Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone
If Selection.Areas.Count <= 1 Then
MsgBox "Please select more than one area."
Else
rangeToUse.Interior.ColorIndex = 38
For Each singleArea In rangeToUse.Areas
singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
Next singleArea
For i = 1 To rangeToUse.Areas.Count
For j = i + 1 To rangeToUse.Areas.Count
For Each cell1 In rangeToUse.Areas(i)
For Each cell2 In rangeToUse.Areas(j)
If cell1.Value = cell2.Value Then
cell1.Interior.ColorIndex = 0
cell2.Interior.ColorIndex = 0
End If
Next cell2
Next cell1
Next j
Next i
End If逻辑说明
- 先清掉整张工作表旧的背景色和边框,避免上次执行的痕迹干扰
- 用
Selection.Areas.Count <= 1检查使用者是不是真的用Ctrl选了不止一块范围,没有就提示重新选取 - 把整个选取范围先统一上色,再逐块加边框,方便看清各区域的边界
- 四层嵌套循环:外两层走过每两块区域的组合(
i、j,j从i+1开始避免重复比较),内两层逐一比较两块区域里的每个单元格 - 只要两个单元格数值相同,就把两者的背景色都清掉——最后还留着颜色的,就是「在其他区域都找不到相同值」的独一无二数据
用 Ctrl 多选好几块范围后运行宏,各区域先被统一上色加边框,重复值清色后只剩独一无二的数据保留底色的效果
学完你会
常见错误
- 使用者只选了一块范围就执行宏,忘记检查
Areas.Count,导致逻辑没有东西可比较 - 内层循环
j没有从i + 1开始,导致同一对区域被重复比较两次 - 想找「不同的值」却把清色逻辑写反,反而把「唯一值」清掉、留下重复值
Sources
Blog / Website: