В любом случае, если мы можем удалить повторяющиеся значения в одной ячейке в Excel? [Дубликат]

Вот моя трещина на нем:

Function Dedupe(MyString As String, MyDelimiter As String)
    Dim MyArr As Variant, MyNewArr() As String, X As Long, Y As Long
    MyArr = Split(MyString, MyDelimiter)
    ReDim MyNewArr(0)
    MyNewArr(0) = MyArr(0)
    Y = 0
    For X = 1 To UBound(MyArr)
        If InStr(1, Join(MyNewArr, MyDelimiter), MyDelimiter & MyArr(X)) = 0 Then
            Y = Y + 1
            ReDim Preserve MyNewArr(Y)
            MyNewArr(Y) = MyArr(X)
        End If
    Next
    Dedupe = Join(MyNewArr, MyDelimiter)
End Function

Вызвать это в коде:

Dedupe(Range("A1").Text,",")

Или как это на листе:

=Dedupe(A1,",")

Первый параметр - это ячейка для проверки, а вторая - разделитель, который вы хотите использовать (в вашем примере это запятая)

Вот функция, которую вы можете использовать для дедуплирования строки, как вы описали. Обратите внимание, что это не будет сортировать дедуплированную строку, поэтому, если ваш был чем-то вроде «4,2,5,1,3,2,2», результат был бы «4,2,5,1,3». Вы не указали, что вам нужно было его отсортировать, поэтому я не включил эту функциональность. Обратите внимание, что функция использует , в качестве разделителя по умолчанию, если не указана, но вы можете указать разделитель, если вы выберете.

Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String

    Dim varSection As Variant
    Dim sTemp As String

    For Each varSection In Split(sInput, sDelimiter)
        If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
            sTemp = sTemp & sDelimiter & varSection
        End If
    Next varSection

    DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)

End Function

Вот несколько примеров того, как вы это назвали:

Sub tgr()

    MsgBox DeDupeString("1,2,3,4,5,2,2")    '--> "1,2,3,4,5"

    Dim myString As String
    myString = DeDupeString("4-2-5-1-3-2-2", "-")
    MsgBox myString     '--> "4-2-5-1-3"

End Sub

попробуйте следующее:

Sub test()
    Dim S$: S = "1,2,3,4,5,2,2,5,6,6,6"
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim Key As Variant
    For Each Key In Split(S, ",")
        If Not Dic.exists(Trim(Key)) Then Dic.Add Trim(Key), Nothing
    Next Key
    S = Join(Dic.Keys, ","): MsgBox S
End Sub

Я предлагаю написать функцию Join, чтобы объединить уникальные части обратно в одну строку (имеется один доступный для массивов, но не для какой-либо другой коллекции):

Function Join(Iterable As Variant, Optional Delimiter As String = ",") As String
    Dim notFirst As Boolean
    Dim item As Variant
    For Each item In Iterable
        If notFirst Then
            Join = Join & Delimiter
        Else
            notFirst = True
        End If
        Join = Join & item
    Next
End Function

Затем используйте Split, чтобы разбить строку на массив и Scripting.Dictionary, чтобы обеспечить уникальность:

Function RemoveDuplicates(s As String, Optional delimiter As String = ",") As String
    Dim parts As String()
    parts = Split(s,delimiter)
    Dim dict As New Scripting.Dictionary
    Dim part As Variant
    For Each part In parts
        dict(part) = 1 'doesn't matter which value we're putting in here
    Next
    RemoveDuplicates = Join(dict.Keys, delimiter)
End Function