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

绝对值排序范围

1 个答案: