Reputation: 799
Let's say I have a couple arrays such as:
array(0) = (a, b, d, e)
array(1) = (c, e, g)
array(2) = (a, c, f, g, h)
Which all have some values in common.
I want to extend the length of these arrays to look like:
(a, b, , d, e, , , )
( , , c, , e, , g, )
(a, , c, , , f, , h)
Basically, I want to make sure all arrays are the same length and that the values will align across each element.
How can I do this with vba code?
I was thinking I would create a collection that stores unique values and ReDimension the existing arrays or create new arrays to mirror the existing one based on the length of the collection. But I don't know how to move the array elements accordingly.
Thanks!
Upvotes: 0
Views: 52
Reputation: 50064
Here's a very clunky cobbled together chunk of code to pull this off. This could definitely use some refactoring, but I think the the overall concept is the right route. Plus this will work for any elements you want to stick into those inner-arrays which is kind of cool.
Sub padArrays()
'Input from question
Dim arr As Variant
ReDim arr(0 To 2)
arr(0) = Array("a", "b", "d", "e")
arr(1) = Array("c", "e", "g")
arr(2) = Array("a", "c", "f", "g", "h")
'Get a dictionary (add reference to Microsoft.Scripting)
Dim arrDict As Scripting.Dictionary
Set arrDict = New Dictionary
'Fill dictionary with distinct values from all inner arrays
'Just using the dictionary to get distinct values here since
'that's uglier to do with pure arrays
For Each singleArray In arr
For Each singleItem In singleArray
If Not arrDict.Exists(singleItem) Then arrDict.Add singleItem, Empty
Next
Next
'Switch back to array just so we can sort (surely there is a better way)
Dim distinctArr As Variant
ReDim distinctArr(0 To arrDict.Count - 1)
Dim arrCounter As Integer: arrCounter = 0
For Each dictItem In arrDict
distinctArr(arrCounter) = dictItem
arrCounter = arrCounter + 1
Next
'Sort the array
QuickSort distinctArr, 0, UBound(distinctArr)
'Back out to a dictionary that has the item as key and the position/index as value
'We can use this when building our desired output
Dim sortDict As Dictionary
Set sortDict = New Dictionary
For distinctIndex = 0 To UBound(distinctArr)
sortDict.Add distinctArr(distinctIndex), distinctIndex
Next
'create a new version of original array, dimensioned appropriately
Dim outArr As Variant
ReDim outArr(0 To UBound(arr), 0 To UBound(distinctArr))
'Loop once again through original multi-dim array but stick everything where it belongs
Dim dim1 As Integer: dim1 = 0
For Each singleArray In arr
For Each singleItem In singleArray
'The key of sortDict dictionary is the item and the value of the dictionary entry has the position
'So we only need grab the dictionary entry for the `singleItem` to know
'which index to stick this thing
outArr(dim1, sortDict(singleItem)) = singleItem
Next
dim1 = dim1 + 1
Next
Stop 'our outArr will have everything where you want it, check the locals window.
End Sub
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
'stolen from https://stackoverflow.com/questions/152319/vba-array-sort-function
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray((inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
In short this is:
Upvotes: 1