How to remove duplicates from an array?

问题:

I am trying to remove duplicate values from an array.

I came across this solution: http://www.livio.net/main/asp_functions.asp?id=RemDups%20Function

It works fine if I hard code an array, via e.g.

theArray = Array("[e-mail]","[e-mail]","[e-mail]","[e-mail]","[e-mail]","[e-mail]")

The duplicates are removed via the test steps shown on the livio.net page:

'--- show array before modifications
response.write "before:<HR>" & showArray (theArray)

'---- remove duplicate string values
theArray = RemDups(theArray)

'--- show the array with no duplicate values
response.write "after:" & showArray (theArray)

However, I am trying to remove duplicates from values which are entered into a textarea on a form.

Assuming I've got the addresses in a standard format where they are comma separated, and are stored in a string called "whotoemail"

So, "whotoemail" contains:

[e-mail],[e-mail],[e-mail],[e-mail],[e-mail],[e-mail]

I tried declaring my array as:

theArray = Array(whotoemail)

Then running through the test steps - the duplicates are not removed. It doesn't seem to recognise that the array has been declared at all, or that it contains any values.

I then thought, maybe the values need to be wrapped in speech marks, so I fudged a clunky way to do that:

testing = Split(whotoemail,",")
loop_address = ""
For i=0 to UBound(testing)
  loop_address = loop_address & "," & chr(34) & trim(testing(i)) & chr(34)
Next

' remove leading comma
left_comma = left(loop_address,1)
if left_comma = "," then
    ttl_len = len(loop_address)
    loop_address = right(loop_address,ttl_len-1)
end if

So now my "whotoemail" string is wrapped in speech marks, just like when I hard coded the Array.

But still the duplicate values are not removed.

Is it not possible to dynamically set the values of the array when declaring the array?

Or am I missing something obvious?

Any advice would be hugely appreciated.

Thanks!

回答1:

I'd use a dictionary for duplicate elimination, because the keys of a dictionary are by definition unique.

Function RemoveDuplicates(str)
  If Trim(str) = "" Then
    RemoveDuplicates = Array()
    Exit Function
  End If

  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = vbTextCompare  'make dictionary case-insensitive

  For Each elem In Split(str, ",")
    d(elem) = True
  Next

  RemoveDuplicates = d.Keys
End Function

回答2:

My Version:

Public Function RemoveDuplicate(byVal arrDuplicate())
Dim sdScriptingDictionary, Item, arrReturn

Set sdScriptingDictionary = CreateObject("Scripting.Dictionary")
sdScriptingDictionary.RemoveAll
sdScriptingDictionary.CompareMode = BinaryCompare
For Each Item In arrDuplicate
    'If item does not exist in dictionary d then add it
    If Not sdScriptingDictionary.Exists(Item) Then sdScriptingDictionary.Add Item, Item
    'If Not sdScriptingDictionary.Exists(item) Then
        'sdScriptingDictionary.Remove(item)
    'End If
Next
arrReturn = sdScriptingDictionary.keys

'Clean Up
Erase arrDuplicate
Set arrDuplicate = Nothing

sdScriptingDictionary.RemoveAll
Set sdScriptingDictionary = Nothing

RemoveDuplicate = arrReturn
End Function

回答3:

You have almost done it. Once you have included the RemDups code

' get the value of the text area (whereever you have it)
whotoemail = textAreaValue

' remove carriage returns
whotoemail = Replace(whotoemail, vbCR, "")

' replace line feeds with separator
whotoemail = Replace(whotoemail, vbLF, ",")

' replace line breaks with separator
whotoemail = Replace(whotoemail, "<br>", ",")

' remove duplicates from text
theArray = RemDups(Split(whotoemail,","))