如何修改Excel VBA宏实现指定重复项着色与排序需求？

云原生阿岚

2026-8-3

说明

本文中提及的rows仅指A列中的单元格，而非整行。

背景

现有两组数据，上方数据称为Data A，下方数据称为Data B。

我已编写一个Macro（下方提供VBA代码），功能如下：

清除工作表全部条件格式；
将所有重复rows标记为红色；
将Data A中的重复rows标记为绿色；
将E列非空单元格标记为黄色；
按以下顺序排序Data A：A列红色单元格、A列绿色单元格、E列黄色单元格、A列值升序、D列值升序。

简言之，该Macro：
a) 将同时存在于Data A和Data B中的重复rows标记为红色；
b) 将Data A内部的重复rows标记为绿色。

需求

现在希望Macro实现以下功能：

清除工作表全部条件格式；
将全数据范围内的重复rows标记为红色；
将Data A中同时存在于Data B的重复rows全部标记为蓝色；
将仅存在于Data A的重复rows标记为绿色；
将E列非空单元格标记为黄色；
按以下顺序排序Data A：A列红色单元格、A列蓝色单元格、A列绿色单元格、E列黄色单元格、A列值升序、D列值升序。

问题

如何实现上述需求？需要对现有Macro做哪些修改或新增内容？若修改难度较大，请告知如何通过条件格式或公式手动实现，我将自行转换为Macro。

当前Macro的VBA代码

'
'
'Declaration
'
'
    Dim MyRange As String
    Dim Rough As String
    Dim A_To_Q As String
    Dim A_To_E As String
    Dim A_To_F As String
    Dim ColumnA As String
    Dim ColumnC As String
    Dim ColumnD As String
    Dim ColumnE As String
    Dim ColumnF As String
'
'
'Assignment
'
'
    MyRange = ActiveCell.Address(0, 0) & ":" & "E1"
'
    Rough = ActiveCell.Offset(0, -2).AddressLocal & ":" & "Q1"
    A_To_Q = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, -2).Address & ":" & "E1"
    A_To_E = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, -2).Address & ":" & "F1"
    A_To_F = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, -2).Address & ":" & "A1"
    ColumnA = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, 0).Address & ":" & "C1"
    ColumnC = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, 1).Address & ":" & "D1"
    ColumnD = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, 2).Address & ":" & "E1"
    ColumnE = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
    Rough = ActiveCell.Offset(0, 3).Address & ":" & "F1"
    ColumnF = Mid(Rough, 2, 1) & Mid(Rough, 4, 6)
'
'
'Formating
'
'
    Cells.FormatConditions.Delete
'
    Columns("A:A").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
'
    Range(ColumnA).Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
'
    Range(ColumnE).Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=LEN(TRIM(E1))>0"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16751204
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10284031
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
'
'
'Sorting
'
'
Range(A_To_F).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnA), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        199, 206)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnA), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, _
        239, 206)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnE), _
        xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
        235, 156)
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(ColumnA) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(ColumnD) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(A_To_F)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

修改方案

一、核心逻辑调整

原代码用xlDuplicate无法区分「跨Data A/B的重复」和「Data A内部重复」，需改用公式型条件格式精准区分三种状态：

红色：全表A列重复（无论属于Data A还是B）
蓝色：Data A中存在于Data B的单元格（且值在全表重复）
绿色：仅Data A内部重复的单元格

二、具体VBA修改步骤

1. 定义Data A和Data B范围

在代码开头添加范围定义（替换为你的实际数据范围）：

Dim DataA_Range As Range
Dim DataB_Range As Range
Set DataA_Range = Range("A1:A100") ' 替换为Data A的A列实际范围
Set DataB_Range = Range("A101:A200") ' 替换为Data B的A列实际范围

2. 替换原有条件格式代码

删除原有的两个FormatConditions.AddUniqueValues段落，替换为以下代码：

（1）标记全表重复为红色

' 全表A列重复标记红色
Columns("A:A").FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=COUNTIF(A:A,A1)>1"
With Columns("A:A").FormatConditions(1)
    .SetFirstPriority
    .Font.Color = -16383844
    .Interior.Color = 13551615
    .StopIfTrue = False
End With

（2）标记Data A中存在于Data B的重复为蓝色

' Data A中同时存在于Data B的单元格标记蓝色
DataA_Range.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=COUNTIF(" & DataB_Range.Address & ",A1)>=1"
With DataA_Range.FormatConditions(1)
    .SetFirstPriority
    .Font.Color = RGB(0, 0, 255)
    .Interior.Color = RGB(189, 215, 238)
    .StopIfTrue = False
End With

（3）标记仅Data A内部重复为绿色

' 仅Data A内部重复的单元格标记绿色
DataA_Range.FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=COUNTIF(" & DataA_Range.Address & ",A1)>1 AND COUNTIF(" & DataB_Range.Address & ",A1)=0"
With DataA_Range.FormatConditions(2)
    .SetFirstPriority
    .Font.Color = -16752384
    .Interior.Color = 13561798
    .StopIfTrue = False
End With

3. 调整排序代码

在原排序规则中新增蓝色单元格的排序优先级，替换原排序代码：

Range(A_To_F).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
' 红色单元格优先
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnA), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 199, 206)
' 新增蓝色单元格排序
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnA), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(189, 215, 238)
' 绿色单元格
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnA), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(198, 239, 206)
' E列黄色单元格
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range(ColumnE), _
    xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, 235, 156)
' A列值升序
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(ColumnA) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' D列值升序
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(ColumnD) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range(A_To_F)
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

三、手动实现方案（无需VBA）

如果不想修改代码，可手动设置条件格式和排序：

全表红色重复：选中A列，条件格式→新建规则→使用公式，输入=COUNTIF(A:A,A1)>1，设置红色字体和填充。
Data A蓝色标记：选中Data A的A列范围，新建规则，输入=COUNTIF(DataB范围,A1)>=1，设置蓝色字体和浅蓝色填充。
Data A绿色标记：选中Data A的A列范围，新建规则，输入=COUNTIF(DataA范围,A1)>1 AND COUNTIF(DataB范围,A1)=0，设置绿色字体和填充。
E列黄色标记：选中E列，新建规则，输入=LEN(TRIM(E1))>0，设置黄色填充。
排序：选中Data A数据区域，排序→自定义排序，依次添加条件：
- 单元格颜色（A列）：红色，升序
- 单元格颜色（A列）：蓝色，升序
- 单元格颜色（A列）：绿色，升序
- 单元格颜色（E列）：黄色，升序
- A列值：升序
- D列值：升序

内容的提问来源于stack exchange，提问作者Syed Hussam

如何修改Excel VBA宏实现指定重复项着色与排序需求？

一、核心逻辑调整 #

二、具体VBA修改步骤 #

1. 定义Data A和Data B范围 #

2. 替换原有条件格式代码 #