Можно ли увеличить длину существующего массива на основе значений, собранных из других массивов? - PullRequest
0 голосов
/ 08 ноября 2019

Допустим, у меня есть пара массивов, таких как:

array(0) = (a, b, d, e)
array(1) = (c, e, g)
array(2) = (a, c, f, g, h)

, которые имеют общие значения.

Я хочу увеличить длину этих массивов, чтобы они выглядели так:

(a, b, , d, e, , , )
( , , c, , e, , g, )
(a, , c, , , f, , h)

По сути, я хочу убедиться, что все массивы имеют одинаковую длину и что значения будут выровнены по каждому элементу.

Как это сделать с помощью кода VBA?

Я думал, что создам коллекцию, в которой будут храниться уникальные значения и переразметим существующие массивы, или создам новые массивы для отражения существующего в зависимости от длины коллекции. Но я не знаю, как переместить элементы массива соответственно.

Спасибо!

1 Ответ

1 голос
/ 09 ноября 2019

Вот очень неуклюжий кусочек кода, чтобы осуществить это. Это может определенно использовать некоторый рефакторинг, но я думаю, что общая концепция - правильный путь. Кроме того, это будет работать для любых элементов, которые вы хотите вставить в те внутренние массивы, что довольно круто.

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 /89926/funktsiya-sortirovki-massiva-vba
  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

Короче говоря, это:

  1. Получение отдельного спискавсе значения из ваших массивов
  2. Сортировка этого списка, чтобы мы могли определить порядковый номер
  3. Сохранение этого списка и соответствующих порядковых номеров в словаре
  4. Создание нового массива массивов с правильными размерами
  5. Вставить все из исходных массивов в правильное положение в соответствии со статьями словаря.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...