Question

我在单元格中有以下类别数据

商业服务 - ＆gt; ISO顾问##商业服务 - ＆gt;商标顾问##电子和家用电器 - ＆gt;净水器

我想检查重复的类别，如果在单元格中找到则删除。分隔符是##。

在上面的示例中，我想要以下输出：

商业服务 - ＆gt; ISO顾问##商标顾问##电子和家用电器 - ＆gt;净水器

正如您可以看到字符串“Business Services - ＆gt;”被删除，因为我在上一个分隔符中有相同的内容。到目前为止，我已经尝试了许多vb脚本，如下所示= returnUniques（Q2，“##”）

Function returnUniques(S As String, Delim As String) As String
    Dim strOut   As String
    Dim Arr      As Variant
    Dim intCount As Integer
    Arr = VBA.Split(S, Delim)
    For intCount = LBound(Arr) To UBound(Arr)
        If Application.Match(Arr(intCount), Arr, 0) = intCount + 1 Then strOut = strOut & Arr(intCount) & Delim
    Next
    returnUniques = Left$(strOut, Len(strOut) - 1)
End Function

但它不起作用。

Answer 1

尝试使用字典获得唯一性。

Option Explicit

Function udfUniqueList(str As String, _
                       Optional delim As String = "##", _
                       Optional cs As Boolean = False)
    Dim a As Long, arr As Variant
    Static dict As Object

    If dict Is Nothing Then
        Set dict = CreateObject("Scripting.Dictionary")
    End If
    dict.RemoveAll
    dict.CompareMode = IIf(cs, vbBinaryCompare, vbTextCompare)

    arr = Split(str, delim)
    For a = LBound(arr) To UBound(arr)
        dict.Item(arr(a)) = a
    Next a

    udfUniqueList = Join(dict.keys, delim)

End Function

Answer 2

以下是Jeeped答案的变体。保证返回一个字符串，其中的项目按原始顺序排列，并保留第一次出现的副本。它已经过修改，以便在"->"之后保留副本的一部分：

Option Explicit

Function returnUniques(S As String, Optional Delim As String = "##") As String
    Dim fields As Variant
    Dim prefix As String
    Dim Arr As Variant
    Dim Keep As Variant
    Dim i As Long
    Dim Dict As Variant

    Set Dict = CreateObject("Scripting.Dictionary")

    Arr = VBA.Split(S, Delim)
    ReDim Keep(0 To UBound(Arr))

    For i = 0 To UBound(Arr)
        fields = Split(Arr(i), "->")

        If UBound(fields) > 0 Then
            If Not Dict.Exists(Trim(fields(0))) Then
                Dict.Add Trim(fields(0)), ""
                Keep(i) = Arr(i)
            Else
                Keep(i) = fields(1)
            End If
        Else
            Keep(i) = Arr(i)
        End If
    Next i

    returnUniques = Join(Keep, Delim)
End Function

通过Excel单元格中的分隔符删除重复的类别字符串

2 个答案: