如何用Excel VBA获取B、C列唯一组合以实现自动筛选并发邮件？

针对你的需求，以下两种方法是获取B、C列唯一组合的最优方案，适配不同场景：

1. 使用Scripting.Dictionary对象（最推荐，高效灵活） #

利用字典的键唯一性特性，将B、C列值拼接成唯一键存入字典，后续可直接提取组合并循环处理。这种方法时间复杂度低，数据量越大优势越明显。

Sub ProcessUniqueBCCombos()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim comboKey As String
    Dim i As Long
    Dim uniqueCombo As Variant
    
    '指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    '获取B列最后一行数据行号
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    '创建字典对象（后期绑定，无需额外引用）
    Set dict = CreateObject("Scripting.Dictionary")
    
    '遍历数据，存入唯一组合
    For i = 2 To lastRow '假设第1行是表头
        '用特殊分隔符拼接B、C值，避免值本身包含的字符导致拆分错误
        comboKey = Trim(ws.Cells(i, "B").Value) & "|" & Trim(ws.Cells(i, "C").Value)
        '仅添加不存在的组合
        If Not dict.Exists(comboKey) Then
            dict.Add comboKey, Array(ws.Cells(i, "B").Value, ws.Cells(i, "C").Value)
        End If
    Next i
    
    '循环处理每个唯一组合
    For Each uniqueCombo In dict.Items
        '设置筛选条件
        ws.Range("A1").AutoFilter Field:=2, Criteria1:=uniqueCombo(0)
        ws.Range("A1").AutoFilter Field:=3, Criteria1:=uniqueCombo(1)
        
        '执行你的邮件宏
        Call YourEmailMacro '替换为实际邮件宏名称
    Next uniqueCombo
    
    '关闭自动筛选
    ws.AutoFilterMode = False
End Sub

注意点： #

• 分隔符（示例中用|）请选择不会出现在B、C列值中的字符，避免拼接后拆分出错；
• 后期绑定字典无需手动添加引用，兼容性更强。

2. 使用Range.RemoveDuplicates方法（代码简洁，适合小数据量） #

借助Excel内置的去重功能，临时复制B、C列数据到其他区域，去重后直接读取结果。代码更简洁，但大数据量下效率略低于字典法。

Sub ProcessUniqueBCCombos_Quick()
    Dim ws As Worksheet
    Dim tempRange As Range
    Dim lastRow As Long
    Dim uniqueRow As Range
    
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    '复制B、C列到临时区域（示例用D、E列）
    Set tempRange = ws.Range("D1:E" & lastRow)
    ws.Range("B1:C" & lastRow).Copy tempRange
    '设置临时表头（确保去重识别表头）
    tempRange.Rows(1).Value = Array("Temp_B", "Temp_C")
    
    '执行去重
    tempRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    
    '遍历去重后的组合
    For Each uniqueRow In ws.Range("D2:E" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row).Rows
        '设置筛选条件
        ws.Range("A1").AutoFilter Field:=2, Criteria1:=uniqueRow.Cells(1).Value
        ws.Range("A1").AutoFilter Field:=3, Criteria1:=uniqueRow.Cells(2).Value
        
        '执行邮件宏
        Call YourEmailMacro
    Next uniqueRow
    
    '清理临时区域并关闭筛选
    tempRange.ClearContents
    ws.AutoFilterMode = False
End Sub

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