1

i have one 2D Array

Original 2D Array 

ArrStore(0,0)="Volvo"
ArrStore(0,1)="BMW"
ArrStore(0,2)="Ford"
ArrStore(0,3)="Ford"
ArrStore(0,4)="Ford"
ArrStore(1,0)="Apple"
ArrStore(1,1)="Orange"
ArrStore(1,2)="Banana"
ArrStore(1,3)="Orange"

Now i want to Remove Deuplicate value from it.

Expected Output must in 2D Array(see below)

ArrStore(0,0)="Volvo"
ArrStore(0,1)="BMW"
ArrStore(0,2)="Ford"
ArrStore(1,0)="Apple"
ArrStore(1,1)="Orange"
ArrStore(1,2)="Banana"

if i am using "Dictionary" then its Remove 2D array pattern.i was searched on Stackoverflow but all the questions are related to One Dimension Array not for 2D Array

Beginners
  • 37
  • 1
  • 6

2 Answers2

1

Assuming you

  1. insist on using a rectangular array
  2. can live with Empty cells
  3. mean "unique per row/column"

you can use a dictionary and move the unique elements to the left/top:

  Dim a(1, 4)
  a(0,0)="Volvo"
  a(0,1)="BMW"
  a(0,2)="Ford"
  a(0,3)="Ford"
  a(0,4)="Ford"
  a(1,0)="Apple"
  a(1,1)="Orange"
  a(1,2)="Banana"
  a(1,3)="Orange"
  WScript.Echo "Before:"
  disp2DA a
  uniq2DA a
  WScript.Echo "After:"
  disp2DA a

Sub uniq2DA(a)
  Dim d : Set d = CreateObject("Scripting.Dictionary")
  Dim i, j, k
  For i = 0 To UBound(a, 1)
      d.RemoveAll
      k = 0
      For j = 0 To UBound(a, 2)
          If Not d.Exists(a(i, j)) Then
             d(a(i, j)) = Empty
             a(i, k) = a(i, j)
             k = k + 1
          End If
      Next
      For j = k To UBound(a, 2)
          a(i, j) = Empty
      Next
  Next
End Sub

Sub disp2DA(a)
  Dim i, j, s
  For i = 0 To UBound(a, 1)
      For j = 0 To UBound(a, 2)
          If IsEmpty(a(i,j)) Then s = " <Empty>" Else s = " " & a(i, j)
          WScript.StdOut.Write s
      Next
      WScript.Echo
  Next
End Sub

output:

Before:
 Volvo BMW Ford Ford Ford
 Apple Orange Banana Orange <Empty>
After:
 Volvo BMW Ford <Empty> <Empty>
 Apple Orange Banana <Empty> <Empty>

If you are willing to use a ragged array, you can use the uniqFE() function from here:

  Dim a : a = Array( _
       Split("Volvo BMW Ford Ford Ford") _
     , Split("Apple Orange Banana Orange Pear") _
  )
  WScript.Echo "Before:"
  disp2DAoA a
  Dim i
  For i = 0 To UBound(a)
      a(i) = uniqFE(a(i))
  Next
  WScript.Echo "After:"
  disp2DAoA a

Sub disp2DAoA(a)
  Dim e
  For Each e In a
      WScript.Echo Join(e)
  Next
End Sub

' returns an array of the unique items in for-each-able collection fex
Function uniqFE(fex)
  Dim dicTemp : Set dicTemp = CreateObject("Scripting.Dictionary")
  Dim xItem
  For Each xItem In fex
      dicTemp(xItem) = 0
  Next
  uniqFE = dicTemp.Keys()
End Function

output:

Before:
Volvo BMW Ford Ford Ford
Apple Orange Banana Orange Pear
After:
Volvo BMW Ford
Apple Orange Banana Pear
Community
  • 1
  • 1
Ekkehard.Horner
  • 38,498
  • 2
  • 45
  • 96
0

below code might help you, i have used this for 2D

Reference link for One dim. code is > http://blogs.technet.com/b/heyscriptingguy/archive/2006/10/27/how-can-i-delete-duplicate-items-from-an-array.aspx 

ArrStore(0,0)="Volvo"
ArrStore(0,1)="BMW"
ArrStore(0,2)="Ford"
ArrStore(0,3)="Ford"
ArrStore(0,4)="Ford"
ArrStore(1,0)="Apple"
ArrStore(1,1)="Orange"
ArrStore(1,2)="Banana"
ArrStore(1,3)="Orange"

for i=0 to 2
    for j=0 to 2
        If Not objDictionary.Exists(ArrStore(i,j)) Then
            objDictionary.Add ArrStore(i,j), ArrStore(i,j)   
        End If
    next
next



intItems = objDictionary.Count - 1

ReDim ArrStore(intItems, intItems)

k = 0

For Each strKey in objDictionary.Keys
    for i=0 to 2
        for j=0 to 2
            ArrStore(i,j) = strKey
            k = k + 1
        next
    next
Next

for i=0 to 2
    for j=0 to 2
        Wscript.Echo ArrStore(i,j)
    next
next
Jaykishan Hirpara
  • 46
  • 5