Microsoft VBA Excel 单元格 重复元素 去重

问题场景

简述：

单元格显示：N/A,A54,N/A,B12,R6,A55，去掉重复的元素。

参考：excel表格同一单元格里剔除重复词怎么做？

---

代码描述

第一步：
在较旧的 Excel 版本中，没有直接的函数可以用来去除字符串中的重复元素。一种解决办法是使用 VBA 来创建一个自定义函数，该函数可以接受一个字符串并返回一个去除了重复项的字符串。

Function UniqueList(inputStr As String, delimiter As String) As String
    Dim dictionary As Object
    Set dictionary = CreateObject("Scripting.Dictionary")
    Dim part As Variant
    Dim parts() As String
    
    parts = Split(inputStr, delimiter)
    
    For Each part In parts
        If Trim(part) <> "" And Not dictionary.Exists(Trim(part)) Then
            dictionary.Add Trim(part), Trim(part)
        End If
    Next part
    
    UniqueList = Join(dictionary.Items, delimiter)
End Function

例如，如果想要处理单元格 A1 中的字符串 N/A,A54,N/A,B12,R6,A55，可以在另一个单元格中使用以下公式：

=UniqueList(A1, ",")

这将返回 N/A,A54,B12,R6,A55。

第二步：
通过这个函数，我们得到的单元格值可能为"1,2,3"、“5,1,3”、“A33,9”，也就是会存在数字乱序、数字和字母乱序，我们想得到"1,2,3"、“1,3,5”、“9,A33”，也就是数字从小到大排列，数字排在字母前面。

首先是修改 UniqueList 函数以返回一个数组而不是字符串。然后，创建一个新的函数来对这个数组进行排序。

首先是更新后的 UniqueList 函数：

Function UniqueList(inputStr As String, delimiter As String) As Variant
    Dim dictionary As Object
    Set dictionary = CreateObject("Scripting.Dictionary")
    Dim part As Variant
    Dim parts() As String
    
    parts = Split(inputStr, delimiter)
    
    For Each part In parts
        If Trim(part) <> "" And Not dictionary.Exists(Trim(part)) Then
            dictionary.Add Trim(part), Trim(part)
        End If
    Next part
    
    UniqueList = dictionary.Items ' 返回数组而非字符串
End Function

接下来是自定义排序函数，创建一个 SortMixedData 函数来处理数字和字母的混合数组：

Function SortMixedData(arr As Variant) As String
    Dim i As Long, j As Long
    Dim temp As String
    
    ' 数字和字母分开排序
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If IsNumeric(arr(i)) And IsNumeric(arr(j)) Then
                If Val(arr(i)) > Val(arr(j)) Then
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                End If
            ElseIf IsNumeric(arr(i)) And Not IsNumeric(arr(j)) Then
                ' 保持数字在字母前
            ElseIf Not IsNumeric(arr(i)) And IsNumeric(arr(j)) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            ElseIf StrComp(arr(i), arr(j), vbTextCompare) > 0 Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    
    ' 将排序后的数组转换回字符串
    SortMixedData = Join(arr, ",")
End Function

在 Excel 单元格中使用这两个函数来获取排序后的唯一值列表：

=SortMixedData(UniqueList(A1, ","))