Excel VBA需求：筛选C列值对应唯一E列值的数据行

需求说明 #

需要筛选数据行，规则是：同一C列值对应的所有E列值必须唯一（G列可以有多条记录）。

• 符合条件的例子：“Ms.LLL”，其对应的C、E列组合唯一，可正常筛选。
• 不符合条件的例子：“Mr.MMM”，对应多个不同的E列值，需弹出提示：“该买家存在冲突店铺”。

已尝试的代码（存在问题） #

Dim WORK_SHEET As Worksheet
Dim UNIRANGE_ONE, UNIRANGE_TWO As Range
Dim COUNT_RANGE As Range
Dim UNIQUE_VALUES As Collection
Dim CELL As Range
Dim CRIT_ONE, CRIT_TWO As String
Dim COUNT_RESULT As Long

Set WORK_SHEET = ThisWorkbook.ActiveSheet
Set UNIRANGE_ONE = WORK_SHEET.Range("C:C")
Set UNIRANGE_TWO = WORK_SHEET.Range("E:E")

Set COUNT_RANGE = WORK_SHEET.Range("G:G")

Set UNIQUE_VALUES = New Collecton ' 拼写错误：应为Collection
For Each CELL In UNIRANGE_ONE
    UNIQUE_VALUES.Add CELL.Value, CStr(CELL.Value)
Next CELL
On Error GoTo 0

For Each CELL In UNIQUE_VALUES
    ' CountIfs参数错误，语法不符合要求
    COUNT_RESULT = Application.WorksheetFunction.CountIfs(UNIRANGE_ONE, UNIRANGE_TWO, CELL, COUNT_RANGE)
Next CELL

'For Each END_USER In ListRange
'UniqueValues.Add CellValue, CStr(Cells(AROW, 7).Value)
'Next
'ENDUSER_COUNT = UniqueValues.Count

解决方案代码 #

用字典跟踪每个C列值对应的E列唯一值集合，判断集合大小是否为1即可确定是否符合条件，之后进行筛选或提示：

Sub FilterValidRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cDict As Object ' 字典：Key=C列值，Item=E列唯一值的集合
    Dim cVal As String, eVal As String
    Dim i As Long
    Dim validCValues As Collection ' 存储符合条件的C列值
    
    Set ws = ThisWorkbook.ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row ' 获取C列最后一行，避免遍历整列
    Set cDict = CreateObject("Scripting.Dictionary")
    Set validCValues = New Collection
    
    ' 遍历数据，构建C列值对应的E列唯一值集合
    For i = 2 To lastRow ' 假设第1行是表头
        cVal = ws.Cells(i, "C").Value
        eVal = ws.Cells(i, "E").Value
        
        If cDict.Exists(cVal) Then
            ' 检查当前E值是否已在集合中，不在则添加
            On Error Resume Next
            cDict(cVal).Add eVal, Key:=eVal
            On Error GoTo 0
        Else
            ' 新建集合存储E列值
            Dim eCol As New Collection
            eCol.Add eVal, Key:=eVal
            cDict.Add cVal, eCol
        End If
    Next i
    
    ' 筛选符合条件的C列值，并处理不符合的情况
    For Each cVal In cDict.Keys
        If cDict(cVal).Count = 1 Then
            validCValues.Add cVal ' 符合条件，加入有效列表
        Else
            MsgBox "该买家存在冲突店铺：" & cVal, vbExclamation ' 提示错误
        End If
    Next cVal
    
    ' 执行筛选：显示所有符合条件的C列值对应的行
    ws.Range("A1").AutoFilter Field:=3, Criteria1:=GetFilterArray(validCValues), Operator:=xlFilterValues
End Sub

' 辅助函数：将Collection转换为数组，用于AutoFilter的Criteria1
Function GetFilterArray(col As Collection) As Variant
    Dim arr() As String
    ReDim arr(1 To col.Count)
    
    Dim i As Long
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    
    GetFilterArray = arr
End Function

代码说明 #

1. 用Scripting.Dictionary存储每个C列值对应的E列唯一值集合，避免重复统计。
2. 遍历数据时只处理到最后一行，提升效率（原代码遍历整列会浪费资源）。
3. 对每个C列值，检查其对应的E列唯一值数量：等于1则符合条件，否则弹出提示。
4. 最后用AutoFilter筛选出所有符合条件的行。

内容的提问来源于stack exchange，提问作者Anpo Desu