CODEWITHSUNDEEP
vbscript
user1495475
user1495475

Reputation: 1057

Remove duplicates from an array

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.

Upvotes: 0

Views: 6275

Answers (4)

ron_dolph
ron_dolph

Reputation: 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

Upvotes: -1

ron_dolph
ron_dolph

Reputation: 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

Upvotes: -1

Moir
Moir

Reputation: 387

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

Upvotes: 0

Ekkehard.Horner
Ekkehard.Horner

Reputation: 38765

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.

Upvotes: 3

Related Questions