我平时做Excel自动化时经常碰到这种需求，给你一套实用的VBA实现方案，完美适配筛选后的动态表格场景：

核心思路 #

1. 先定位筛选后F列的可见单元格（忽略被隐藏的行）
2. 用「集合（Collection）」自动去重——集合的Key属性天生不允许重复值，刚好解决你的需求
3. 把集合转成动态长度的数组，最后用Join函数拼接成邮件主题需要的格式

完整VBA代码 #

Sub GetUniqueValuesAndBuildSubject()
    Dim visibleRange As Range
    Dim cell As Range
    Dim uniqueCollection As New Collection
    Dim uniqueArr() As Variant
    Dim i As Integer
    Dim emailSubject As String
    
    ' 1. 获取筛选后F列的可见单元格（跳过表头的话可以改成Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row)）
    On Error Resume Next
    Set visibleRange = Range("F:F").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    ' 处理无可见数据的情况
    If visibleRange Is Nothing Then
        emailSubject = "无有效数据"
        MsgBox emailSubject
        Exit Sub
    End If
    
    ' 2. 遍历可见单元格，用集合去重（跳过空单元格）
    On Error Resume Next ' 重复值添加集合会报错，直接跳过
    For Each cell In visibleRange
        If Trim(cell.Value) <> "" Then ' 排除空单元格和纯空格
            uniqueCollection.Add cell.Value, Key:=CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' 3. 把集合转成动态数组
    ReDim uniqueArr(1 To uniqueCollection.Count)
    For i = 1 To uniqueCollection.Count
        uniqueArr(i) = uniqueCollection(i)
    Next i
    
    ' 4. 拼接邮件主题（这里可以自定义前缀和分隔符）
    If uniqueCollection.Count > 0 Then
        emailSubject = "处理完成：" & Join(uniqueArr, ", ") ' 用逗号分隔，可改成"、"或其他符号
    Else
        emailSubject = "无有效唯一值"
    End If
    
    ' 测试输出（实际使用时可以替换成邮件发送代码）
    MsgBox "邮件主题：" & emailSubject
End Sub

代码关键说明 #

• SpecialCells(xlCellTypeVisible)：精准获取筛选后显示的单元格，不会包含被隐藏的行数据
• 集合去重：利用集合Key的唯一性，重复值添加时会触发错误，通过On Error Resume Next跳过重复项
• 动态数组：用ReDim根据集合的长度（也就是唯一值的数量）调整数组大小，完美适配不同数量的唯一值
• Join函数：快速把数组元素拼接成字符串，分隔符可以根据需求修改（比如中文场景用顿号、）

扩展提示 #

如果你的表头在F1行，建议把获取范围改成Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row)，避免把表头也加入到数组里。

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