Диапазон сортировки по абсолютной величине

Question

Я бы хотел отсортировать диапазон по абсолютной величине, но сохранить знак числа.

Я сделал код, который работает нормально, но я копирую / вставляю значения в другом диапазоне, а затем удаляю его.

Я бы не хотел копировать / вставлять в свой лист, а просто делать это в памяти.

Как я могу это сделать?

Мой диапазон:

-1
2
3
-4
4.5

Ожидаемый результат:

4.5
-4
3
2
-1

Мой код:

Sub Appel()

    For i = 1 To Range("D1").End(xlDown).Row
        Range("E" & i) = Abs(Range("D" & i).Value)
    Next i

    Range("E1", Range("D1").End(xlDown)).Sort Key1:=Range("E1"), 
    Order1:=xlDescending, Header:=xlNo

    Columns("E:E").Delete

End Sub 

Answer 1

Чтобы сделать это в памяти, я сначала загрузил бы его в одномерный массив.

Затем я бы создал специальную функцию, которая выполняет пользовательскую сортировку массива.

После сортировки, а затем просто установите значение в этом диапазоне из отсортированного массива.

Sub Appel()

    Dim TargetRange As Range
    Set TargetRange = Range("D1", Range("D" & Rows.Count).End(xlUp))

    'This returns as single dim array from a Range column
    Dim ColumnData As Variant
    ColumnData = Application.Transpose(TargetRange.Value)

    Dim SortedData As Variant
    SortedData = SortAbsoluteDecending(ColumnData)

    'Set value of range equal to the new sorted array.
    TargetRange.Value = Application.Transpose(SortedData)

End Sub

Public Function SortAbsoluteDecending(SourceArray As Variant) As Variant

    Dim OuterIndex As Long
    For OuterIndex = LBound(SourceArray) To UBound(SourceArray) - 1

        Dim InnerIndex As Long
        For InnerIndex = OuterIndex + 1 To UBound(SourceArray)

            If Abs(SourceArray(OuterIndex)) < Abs(SourceArray(InnerIndex)) Then
                Dim Temp As Variant
                Temp = SourceArray(InnerIndex)
                SourceArray(InnerIndex) = SourceArray(OuterIndex)
                SourceArray(OuterIndex) = Temp
            End If

        Next InnerIndex
    Next OuterIndex

    SortAbsoluteDecending = SourceArray

End Function