删除字符串函数中的重复文本

时间:2018-02-08 16:46:49

标签: string function access-vba duplicates

我有一个函数来删除Access表的单个列中的重复文本字符串:

原始价值:持卡人,调解员,调解人,持卡人,审批人

所需输出:持卡人,调解人,审批人。

我有以下功能可以实现,但如果只有一个值可以返回,则会留下一个悬挂的逗号(例如" Cardholder,")

Function stringOfUniques(inputString As String) As String
        Dim inArray() As String
        Dim xVal As Variant
        Dim s As String
        inArray = Split(inputString, ",")
        For Each xVal In inArray
            If InStr(s, Trim(xVal)) = 0 Then _
            s = s & Trim(xVal) & " ,"
        Next xVal
        stringOfUniques = s
    End Function

应该调整哪一部分来反映这种变化?

感谢。

2 个答案:

答案 0 :(得分:0)

将数组的成员字符串作为键添加到Scripting.Dictionary对象。

然后,您可以通过连接字典的键来产生所需的输出字符串。

Public Function stringOfUniques(inputString As String) As String
    Dim xVal As Variant
    Dim strTrimmed As String
    Dim dct As Object
    Set dct = CreateObject("Scripting.Dictionary")
    For Each xVal In Split(inputString, ",")
        strTrimmed = Trim(xVal)
        If Len(strTrimmed) > 0 And Not dct.Exists(strTrimmed) Then
            dct.Add key:=strTrimmed, Item:=Null
        End If
    Next
    stringOfUniques = Join(dct.Keys, ", ")
End Function

答案 1 :(得分:-1)

使用instr来测试字符串中是否已存在该项将对包含其他字符串的字符串失败(例如,对于"pineapple,apple"的输入,您的方法将返回"pineapple"

要提供替代方法,请考虑以下功能:

Function StringOfUniques(strArg As String) As String
    Dim col As New Collection, var
    On Error Resume Next
    For Each var In Split(strArg, ",")
        col.Add var, var
    Next var

    Dim rtn() As String, i As Long
    ReDim rtn(1 To col.Count)
    For i = 1 To col.Count
        rtn(i) = col(i)
    Next i

    StringOfUniques = Join(rtn, ",")
End Function

一些例子:

?StringOfUniques("a,b,c")
a,b,c

?StringOfUniques("a,a,b,b,c,c")
a,b,c

?StringOfUniques("pineapple,apple")
pineapple,apple

这种方法构建&填充Collection对象并依赖于与Collection中每个项目关联的键必须唯一的要求(因此使用On Error Resume Next来考虑迭代,这些迭代尝试添加其键已经出现在Collection中的项目)

这种捕获预期错误的方法可能不是最优雅的解决方案,但可能比不断迭代数组以测试项目是否已存在更有效。