从Visual Basic

时间:2015-08-20 20:18:16

标签: vba

在Visual Basic中,如果我有一串数字可以说(" 1,2,3,4,5,2,2"),我该如何删除重复值并且只留下第一个实例所以字符串说(" 1,2,3,4,5")。

5 个答案:

答案 0 :(得分:6)

这是一个可用于重复删除字符串的函数,如您所述。请注意,这不会对重复数据删除的字符串进行排序,因此,如果您的字符串类似于“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

答案 1 :(得分:0)

我建议编写一个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

答案 2 :(得分:0)

试试这个:

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

答案 3 :(得分:0)

继承我的裂缝:

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 :(得分:0)

vb6,在没有分隔符的情况下查找单词中的重复字母。

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