Removing Duplicate values from a string in VBA

前端 未结 5 2046
伪装坚强ぢ
伪装坚强ぢ 2020-12-18 17:05

In VBA if I have a string of numbers lets say ("1,2,3,4,5,2,2"), how can I remove the duplicate values and only leave the first instance so the string says ("

相关标签:
5条回答
  • 2020-12-18 17:11

    try this:

    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
    
    0 讨论(0)
  • 2020-12-18 17:21

    vb6,Find Duplicate letter in word when there is no delimiter.

    Function RemoveDuplicateLetter(ByVal MyString As String) As String
    Dim MyArr As Variant, MyNewArr() As String, X As String,str as String
    Dim bValue As Boolean
    Dim i As Long, j As Long
    For i = 0 To Len(MyString)
        str = str & Mid$(MyString, i + 1, 1) & vbNullChar
    Next
    
    i = 0
    MyArr = Split(str, vbNullChar)
    ReDim MyNewArr(0)
    MyNewArr(0) = MyArr(0)
    
    For i = LBound(MyArr) To UBound(MyArr)
        bValue = True
        For j = i + 1 To UBound(MyArr)
            If MyArr(i) = MyArr(j) Then
                bValue = False
                Exit For
            End If
        Next
        If bValue Then X = X & " " & MyArr(i)
    Next
    RemoveDuplicateLetter = X
    End Function
    
    0 讨论(0)
  • 2020-12-18 17:23

    Here is a function you can use to dedupe a string as you've described. Note that this won't sort the deduped string, so if yours was something like "4,2,5,1,3,2,2" the result would be "4,2,5,1,3". You didn't specify you needed it sorted, so I didn't include that functionality. Note that the function uses , as the default delimiter if not specified, but you can specify a delimiter if you choose.

    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
    

    Here's some examples of how you would call it:

    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
    
    0 讨论(0)
  • 2020-12-18 17:29

    Heres my crack at it:

    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
    

    Call it like this in code:

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

    Or like this in the sheet:

    =Dedupe(A1,",")
    

    The first parameter is the cell to test and the second is the delimiter you want to use (in your example it is the comma)

    0 讨论(0)
  • 2020-12-18 17:37

    I suggest writing a Join function to combine the unique parts back into a single string (there is one available for arrays, but not for any other collection):

    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
    

    Then, use Split to split a string into an array, and Scripting.Dictionary to enforce uniqueness:

    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
    
    0 讨论(0)
提交回复
热议问题