0

How can I remove duplicates from an array in vbscript?

Code:

     dim XObj(100),xObjXml
      for s=0 to xObjXml.length-1      
      XObj(s)=xObjXml(s).getAttribute("xsx")
      next

Please suggest a better answer for this.

4 Answers 4

3

Use a Dictionary to gather the unique items of the array:

>> a = Array(1, 2, 3, 1, 2, 3)
>> WScript.Echo Join(a)
>> Set d = CreateObject("Scripting.Dictionary")
>> For i = 0 To UBound(a)
>>     d(a(i)) = d(a(i)) + 1
>> Next
>> WScript.Echo Join(d.Keys())
>>
1 2 3 1 2 3
1 2 3
>>

(BTW: There is no .length property for VBScript arrays)

Added:

The .Keys() method of the dictionary returns an array of the (unique) keys:

>> b = d.Keys()
>> WScript.Echo Join(b), "or:", b(2), b(1), b(0)
>>
1 2 3 or: 3 2 1

Added II: (aircode!)

Trying to get the unique attributes of the objects in an XML collection:

Dim xObjXml  : Set xObjXml  = ... get some collection of XML objects ...
Dim dicAttrs : Set dicAttrs = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To xObjXml.length - 1                 
    Dim a : a = xObjXml(i).getAttribute("xsx")  
    dicAttrs(a) = dicAttrs(a) + 1
Next
Dim aAttrs : aAttrs = dicAttrs.Keys()

Added III (sorry!):

.Keys() is a method, so it should be called as such:

Dim aAttrs : aAttrs = dicAttrs.Keys()

Added IV:

For a working sample see here.

Sign up to request clarification or add additional context in comments.

3 Comments

:Thanks for the answer.Wheres new array here?Where itll store?And please check the changes i`ve done in post.
This is not working for me,Could you please use the array variable i`ve used n get me a example?
It`s saying invalid property asignment for "aAttrs = dicAttrs.Keys".Is there any syntax wrong in here?
0

If you don't want a Dictionary you can use the following to compare each element in the array to itself.

Info = Array("Arup","John","Mike","John","Lisa","Arup")

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

Comments

-1

With help of Moir's solution here is a complete clearing function:

Function RemoveDuplicityItem(myarray)
remove = Array()
If IsArray(myarray) Then
    x = 0
    z = Ubound(myArray)
    Do
        x = x + 1
        Do
            z = z - 1
            If x = z Then
                myArray(x) = myArray(z)
            ElseIf myArray(x) = myArray(z) Then
                myArray(x) = "DUPLICITY" & x ' Write down duplicity flag
                remove = AddItem(remove, myArray(x)) ' Write down the same to array
            End If
        Loop Until z = 0
        z = Ubound(myArray)
    Loop Until x = Ubound(myArray)
End If
If IsArray(remove) Then
    For i = 0 to Ubound(remove) ' Run loop on remove array                 
        'WScript.Echo i & ": " & remove(i)
        For j = 0 To Ubound(myArray) 'Redim -1 correction
            If myArray(j) = remove(i) Then
                position = j
            Else
            End If
        Next
        Done = RemoveItem(myArray, position) 'The goal, to clear myArray on remove loop
    Next
End If
End Function

Function RemoveItem(arr, pos)
    Dim i
    For i = pos To UBound(arr) - 1
            arr(i) = arr(i + 1)
    Next
    ReDim Preserve arr(UBound(arr) - 1)
End Function

1 Comment

Your answer could be improved with additional supporting information. Please edit to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers in the help center.
-1

With help of Moir's solution here comes a complete clearing function:

Function RemoveDuplicityItem(myarray)
remove = Array()
If IsArray(myarray) Then
    x = 0
    z = Ubound(myArray)
    Do
        x = x + 1
        Do
            z = z - 1
            If x = z Then
                myArray(x) = myArray(z)
            ElseIf myArray(x) = myArray(z) Then
                myArray(x) = "DUPLICITY" & x ' Write down duplicity flag
                remove = AddItem(remove, myArray(x)) ' Write down the same to array
            End If
        Loop Until z = 0
        z = Ubound(myArray)
    Loop Until x = Ubound(myArray)
End If
If IsArray(remove) Then
    For i = 0 to Ubound(remove) ' Run loop on remove array                 
        'WScript.Echo i & ": " & remove(i)
        For j = 0 To Ubound(myArray) 'Redim -1 correction
            If myArray(j) = remove(i) Then
                position = j
            Else
            End If
        Next
        Done = RemoveItem(myArray, position) 'The goal, to clear myArray on remove loop
    Next
End If
End Function

Function RemoveItem(arr, pos)
    Dim i
    For i = pos To UBound(arr) - 1
            arr(i) = arr(i + 1)
    Next
    ReDim Preserve arr(UBound(arr) - 1)
End Function

That's it

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.