Question

我正在尝试从数组中删除重复的值。

我遇到了这个解决方案： http://www.livio.net/main/asp_functions.asp?id=RemDups%20Function

如果我通过例如硬编码数组，它可以正常工作。

theArray = Array("me@me.com","sid@sid.com","bob@bob.com","other@test.com","other@test.com","other@test.com")

通过livio.net页面上显示的测试步骤删除重复项：

'--- 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)

但是，我正在尝试从输入到表单上的textarea的值中删除重复项。

假设我的标准格式的地址以逗号分隔，并存储在名为“whotoemail”的字符串中

所以，“whotoemail”包含：

me@me.com,sid@sid.com,bob@bob.com,other@test.com,other@test.com,other@test.com

我尝试将我的数组声明为：

theArray = Array(whotoemail)

然后运行测试步骤 - 不删除重复项。它似乎没有认识到数组已经被声明，或者它包含任何值。

然后我想，也许价值需要用语音标记包裹起来，所以我捏造了一种笨重的方式来做到这一点：

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

所以现在我的“whotoemail”字符串被包含在语音标记中，就像我对数组进行硬编码一样。

但是仍然没有删除重复的值。

在声明数组时是否无法动态设置数组的值？

或者我错过了一些明显的东西？

非常感谢任何建议。

谢谢！

Answer 1

我使用dictionary进行重复删除，因为根据定义字典的键是唯一的。

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

Answer 2

我的版本：

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

Answer 3

你差不多完成了。一旦你包含了RemDups代码

' 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,","))

Answer 4

如果您不需要 Dictionary，您可以使用以下命令将数组中的每个元素与其自身进行比较。

Info = Array("me@me.com","sid@sid.com","bob@bob.com","other@test.com","other@test.com","other@test.com")

x = 0
z = ubound(Info)
Do
x = x + 1
Do
z = z - 1
If x = z Then
Info(x) = Info(z)
ElseIf Info(x) = Info(z) Then
Info(x) = ""
End If
Loop Until z=0
z = ubound(Info)
Loop Until x = ubound(Info)
For each x in Info 
If x <> "" Then
Unique = Unique & Chr(13) & x
End If
Next

MsgBox Unique

如何从数组中删除重复项？

4 个答案: