Присвоение переменной ссылки на массив

[Zefyry]

Добрый день! Пытаюсь выполнить сортировку двумерного массива по одному из столбцов не изменяя сам массив, другими словами я хочу получить на выходе массив лишь из 2 столбцов, 1 - содержит значение из столбца по которому идет сортировка, 2 - содержит номер строки этого значения в исходном массиве. Реализовать сортировку пытаюсь неким подобием пирамидальной сортировки используя вместо ссылок вложенные массивы (может не совсем разумно, но сейчас уже вопрос интереса встал). Вот пример:

Sub test()
    Dim a As Variant, b As Variant
    ReDim a(1 To 5, 1 To 2)
    a(1, 1) = "sadsa"
    a(2, 1) = "fggrew"
    a(3, 1) = "weffca"
    a(4, 1) = "asfewcc"
    a(5, 1) = "awww"
    b = sortedArrAsColumn(a, 2, 1)
End Sub
Function sortedArrAsColumn(inputArr As Variant, startRowIndex As Variant, colIndex As Variant) As Variant
    Dim a As Variant, b As Variant
    For i = startRowIndex To UBound(inputArr)
        addElemThree a, UCase(inputArr(i, colIndex)), i
    Next i
    ReDim b(1 To UBound(inputArr) - startRowIndex + 1, 1 To 2)
    backThree a, b, 1
    sortedArrAsColumn = b
End Function
Sub addElemThree(arrThree As Variant, newValue As Variant, newIndex As Variant)
    Dim a As Variant
    ReDim a(1 To 4)
    If IsEmpty(arrThree) Then
        a(2) = newValue
        a(3) = newIndex
        arrThree = a
    Else
        If arrThree(2) > newValue Then
            addElemThree arrThree(1), newValue, newIndex
        ElseIf arrThree(2) < newValue Then
            addElemThree arrThree(4), newValue, newIndex
        Else
            arrThree(3) = CStr(arrThree(3)) & "|" & newIndex
        End If
    End If
End Sub
Sub backThree(arrThree As Variant, outArr As Variant, nextIndex As Variant)
    Dim arrTemp As Variant
    If nextIndex <= UBound(outArr) Then
        If IsEmpty(arrThree(1)) Then
            arrTemp = Split(arrThree(3), "|")
            For i = 0 To UBound(arrTemp)
                outArr(nextIndex, 1) = arrThree(2)
                outArr(nextIndex, 2) = arrTemp(i)
                nextIndex = nextIndex + 1
            Next i
        Else
            backThree arrThree(1), outArr, nextIndex
            arrTemp = Split(arrThree(3), "|")
            For i = 0 To UBound(arrTemp)
                outArr(nextIndex, 1) = arrThree(2)
                outArr(nextIndex, 2) = arrTemp(i)
                nextIndex = nextIndex + 1
            Next i
        End If
        If Not IsEmpty(arrThree(4)) Then backThree arrThree(4), outArr, nextIndex
    End If
End Sub

Данный пример работает, все нормально, но если количество элементов слишком велико, то происходит переполнение стека вызовов. Отсюда возникает задача переписать рекурсивный вызов в цикл, а для этого нужно как-то реализовать перемещение по вложенным массивам. Проблема в том, что при присвоении одного массива другому, создается новая копия, а не ссылка на уже имеющийся из-за чего вот такой код не имеет смысла:

Sub addElemThree(arrThree As Variant, newValue As Variant, newIndex As Variant)
    Dim a As Variant, tArr As Variant, oldTArr As Variant
    ReDim a(1 To 4)
    a(2) = newValue
    a(3) = newIndex
    If IsEmpty(arrThree) Then
        arrThree = a
    Else
        tArr = arrThree
        oldTArr = ta
        Do
            If tArr(2) > newValue Then
                If IsEmpty(tArr(1)) Then
                    tArr(1) = a
                    Exit Do
                Else
                    tArr = tArr(1)
                End If
            ElseIf tArr(2) < newValue Then
                If IsEmpty(tArr(4)) Then
                    tArr(4) = a
                    Exit Do
                Else
                    tArr = tArr(4)
                End If
            Else
                tArr(3) = CStr(tArr(3)) & "|" & newIndex
                Exit Do
            End If
        Loop
    End If
End Sub

Как организовать занесение в переменную ссылку на оригинал и тем самым сохранить изменения совершенные во вложенном массиве, в оригинале?

[Fck_This]

Сообщение от Zefyry

... не совсем разумно, но сейчас уже вопрос интереса встал...

wtf? Вы уж извините, но если не разумно, то зачем делать, даже если у вас встаёт вопрос интереса... зачем создавать новые массивы, если есть один старый. В крайнем случае использовать один временный.

[Zefyry]

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

[Zefyry]

Придумал решение проблемы через создание пользовательского класса, т.к. мы обращаемся к нему как к объекту, то ссылки должны были отлично срабатывать. Создал класс PointerArray:

Private data As Variant
Private Sub Class_Initialize()
    ReDim data(1 To 4)
End Sub
Public Property Let value(newValue As Variant)
    data(2) = newValue
End Property
Public Property Let index(newValue As Variant)
    data(3) = newValue
End Property
Public Property Let left(newValue As PointerArray)
    Set data(1) = newValue
End Property
Public Property Let right(newValue As PointerArray)
    Set data(4) = newValue
End Property
Public Property Get value() As Variant
    value = data(2)
End Property
Public Property Get index() As Variant
    index = data(3)
End Property
Public Property Get left() As PointerArray
    Set left = data(1)
End Property
Public Property Get right() As PointerArray
    Set right = data(4)
End Property
Public Property Get isLeft() As Boolean
    isLeft = IsEmpty(data(1))
End Property
Public Property Get isRight() As Boolean
    isRight = IsEmpty(data(4))
End Property

Переписал процедуры под новый класс:

Function sortedArrAsColumn(inputArr As Variant, startRowIndex As Variant, colIndex As Variant) As Variant
    Dim b As Variant
    Dim a As PointerArray, c As PointerArray
    For i = startRowIndex To UBound(inputArr)
        Set c = New PointerArray
        c.value = UCase(inputArr(i, colIndex))
        c.index = i
        addElemThreeNEW a, c
    Next i
    ReDim b(1 To UBound(inputArr) - startRowIndex + 1, 1 To 2)
    backThree a, b, 1
    sortedArrAsColumn = b
End Function
Sub addElemThreeNEW(arrThree As PointerArray, newValue As PointerArray)
    Dim tArr As PointerArray, oldTArr As Variant
    If arrThree Is Nothing Then
        Set arrThree = newValue
    Else
        Set tArr = arrThree
        'oldTArr = ta
        Do
            If tArr.value > newValue.value Then
                If tArr.isLeft Then
                    tArr.left = newValue
                    Exit Do
                Else
                    Set tArr = tArr.left
                End If
            ElseIf tArr.value < newValue.value Then
                If tArr.isRight Then
                    tArr.right = newValue
                    Exit Do
                Else
                    Set tArr = tArr.right
                End If
            Else
                tArr.index = CStr(tArr.index) & "|" & newValue.index
                Exit Do
            End If
        Loop
    End If
End Sub
Sub backThree(arrThree As PointerArray, outArr As Variant, nextIndex As Variant)
    Dim arrTemp As Variant
    If nextIndex <= UBound(outArr) Then
        If arrThree.isLeft Then
            arrTemp = Split(CStr(arrThree.index), "|")
            For i = 0 To UBound(arrTemp)
                outArr(nextIndex, 1) = arrThree.value
                outArr(nextIndex, 2) = arrTemp(i)
                nextIndex = nextIndex + 1
            Next i
        Else
            backThree arrThree.left, outArr, nextIndex
            arrTemp = Split(arrThree.index, "|")
            For i = 0 To UBound(arrTemp)
                outArr(nextIndex, 1) = arrThree.value
                outArr(nextIndex, 2) = arrTemp(i)
                nextIndex = nextIndex + 1
            Next i
        End If
        If Not arrThree.isRight Then backThree arrThree.right, outArr, nextIndex
    End If
End Sub

Все отлично работает, никакого переполнения, никаких ошибок, сортировка работает как часы! Вот только если сортировать большой массив уникальных значений, то из-за многократной инициализации класса и обращению к его свойствам (ну по крайней мере я думаю, что из-за этого), производительность сортировки многократно упала и если раньше она была в 4-5 раз быстрее, чем сортировка вставками, то теперь она проигрывает ей в 2-2,5 раза, так что вопрос по реализации пирамидальной сортировки в VBA остается открытым. С удовольствием выслушаю любые предложения по модификации моего подхода, использования каких-либо других конструкций или абсолютно иной подход к данному вопросу, в общем буду рад рассмотреть любые варианты!

[Serge 007]

Кросс