Добрый день! Пытаюсь выполнить сортировку двумерного массива по одному из столбцов не изменяя сам массив, другими словами я хочу получить на выходе массив лишь из 2 столбцов, 1 - содержит значение из столбца по которому идет сортировка, 2 - содержит номер строки этого значения в исходном массиве. Реализовать сортировку пытаюсь неким подобием пирамидальной сортировки используя вместо ссылок вложенные массивы (может не совсем разумно, но сейчас уже вопрос интереса встал). Вот пример: [vba]
Код
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
[/vba] Данный пример работает, все нормально, но если количество элементов слишком велико, то происходит переполнение стека вызовов. Отсюда возникает задача переписать рекурсивный вызов в цикл, а для этого нужно как-то реализовать перемещение по вложенным массивам. Проблема в том, что при присвоении одного массива другому, создается новая копия, а не ссылка на уже имеющийся из-за чего вот такой код не имеет смысла: [vba]
Код
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
[/vba] Как организовать занесение в переменную ссылку на оригинал и тем самым сохранить изменения совершенные во вложенном массиве, в оригинале?
Добрый день! Пытаюсь выполнить сортировку двумерного массива по одному из столбцов не изменяя сам массив, другими словами я хочу получить на выходе массив лишь из 2 столбцов, 1 - содержит значение из столбца по которому идет сортировка, 2 - содержит номер строки этого значения в исходном массиве. Реализовать сортировку пытаюсь неким подобием пирамидальной сортировки используя вместо ссылок вложенные массивы (может не совсем разумно, но сейчас уже вопрос интереса встал). Вот пример: [vba]
Код
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
[/vba] Данный пример работает, все нормально, но если количество элементов слишком велико, то происходит переполнение стека вызовов. Отсюда возникает задача переписать рекурсивный вызов в цикл, а для этого нужно как-то реализовать перемещение по вложенным массивам. Проблема в том, что при присвоении одного массива другому, создается новая копия, а не ссылка на уже имеющийся из-за чего вот такой код не имеет смысла: [vba]
Код
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
[/vba] Как организовать занесение в переменную ссылку на оригинал и тем самым сохранить изменения совершенные во вложенном массиве, в оригинале?Zefyry