求稳定可用的VBA自定义函数：提取指定区域唯一值并按分隔符拼接

看来你写的UNIQUE_NUMBER函数偶尔失效，主要是因为原实现依赖字符串搜索替换的逻辑存在不少隐患——比如WorksheetFunction.Search找不到匹配时会抛出错误，未初始化的变量a会导致异常，重复替换分隔符的方式也不够可靠。

我推荐用Scripting.Dictionary来重构这个函数，它天然支持唯一键的特性，能完美解决去重需求，而且逻辑清晰、稳定性高。

改进后的可靠实现 #

这个版本用后期绑定的Dictionary（不需要手动添加引用），自动处理去重，同时兼顾空单元格和空格的情况：

Function UNIQUE_NUMBER(RangeD As Range, SepCharacter As String) As String
    Dim cell As Range
    Dim uniqueDict As Object
    Dim resultArr() As String
    Dim i As Integer
    
    ' 创建Dictionary对象（后期绑定，无需手动添加引用）
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    ' 设置比较模式：vbTextCompare不区分大小写，vbBinaryCompare区分大小写，按需调整
    uniqueDict.CompareMode = vbTextCompare
    
    ' 遍历目标区域的每个单元格
    For Each cell In RangeD
        ' 跳过空单元格
        If Not IsEmpty(cell.Value) Then
            Dim cellVal As String
            cellVal = Trim(cell.Value) ' 去除内容前后空格，不需要的话可以删掉该行
            If cellVal <> "" Then
                ' 利用Dictionary的键唯一性自动去重，重复值不会被添加
                uniqueDict(cellVal) = True
            End If
        End If
    Next cell
    
    ' 把去重后的内容用指定分隔符连接
    If uniqueDict.Count > 0 Then
        ReDim resultArr(0 To uniqueDict.Count - 1)
        ' 将Dictionary的键（即唯一值）存入数组
        For i = 0 To uniqueDict.Count - 1
            resultArr(i) = uniqueDict.Keys()(i)
        Next i
        ' 用分隔符+空格连接（如果不需要空格，改成Join(resultArr, SepCharacter)即可）
        UNIQUE_NUMBER = Join(resultArr, SepCharacter & " ")
    Else
        ' 没有有效内容时返回空字符串
        UNIQUE_NUMBER = ""
    End If
    
    ' 释放对象，避免内存泄漏
    Set uniqueDict = Nothing
End Function

为什么这个版本更可靠？ #

• 天然去重：Dictionary的键不能重复，所以不需要手动做字符串搜索判断，从根源避免了原函数的逻辑漏洞
• 稳定无异常：不会因为字符串搜索失败触发错误跳转，也没有未初始化变量的问题
• 灵活调整：可以通过修改CompareMode设置是否区分大小写，也可以去掉Trim()保留原始空格
• 效率更高：对于大区域来说，Dictionary的查找效率远高于字符串搜索替换

示例用法 #

比如你有区域A1:A10包含重复的产品代码，在任意单元格输入：

=UNIQUE_NUMBER(A1:A10, ",")

就能得到格式为0001, 0015, 0020的去重结果。

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