vbscriptSampleCode/src/vbs/Deduplication.vbs at master · SungmanHan/vbscriptSampleCode · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit

'--------------------------------------------------------------------------------
' ScriptName    : Deduplication.vbs
' Creator       : Sungman Han
' Creation Date : 2019-06-15
' Description   : Removes duplicate tokens from a delimited string, keeping the
'                 first occurrence of each one.
'
' Usage         : DistinctTokens("a,a,c,c,b,b,e,j,j,k", ",")  -> "a,c,b,e,j,k"
'                 DistinctTokens("1000,1010,1000", ",")       -> "1000,1010"
'
' Note          : matching is whole token, not substring, so multi character values
'                 such as plant or material codes are handled correctly. Empty
'                 tokens are dropped and every token is trimmed.
'--------------------------------------------------------------------------------

Const TEXT_COMPARE = 1   ' vbTextCompare, i.e. case insensitive

Function DistinctTokens(vValue, vDelimiter)
  Dim vSeen, vToken, vResult

  Set vSeen = CreateObject("Scripting.Dictionary")
  vSeen.CompareMode = TEXT_COMPARE
  vResult = ""

  For Each vToken In Split(vValue & "", vDelimiter)
    vToken = Trim(vToken)
    If vToken <> "" And Not vSeen.Exists(vToken) Then
      vSeen.Add vToken, True
      If vResult <> "" Then vResult = vResult & vDelimiter
      vResult = vResult & vToken
    End If
  Next

  Set vSeen = Nothing
  DistinctTokens = vResult
End Function