按降序排序一组数字（1000-10000数但可能有所不同）的最快方式（就计算时间而言）是多少？据我所知，Excel内置函数效率不高，内存中的排序应该比Excel函数快得多。
请注意，我无法在电子表格中创建任何内容，所有内容都必须存储并仅在内存中排序。
答案 0 :(得分：6)
您可以使用System.Collections.ArrayList：
Dim arr As Object
Dim cell As Range
Set arr = CreateObject("System.Collections.ArrayList")
' Initialise the ArrayList, for instance by taking values from a range:
For Each cell In Range("A1:F1")
arr.Add cell.Value
Next
arr.Sort
' Optionally reverse the order
arr.Reverse
这使用快速排序。
答案 1 :(得分：2)
只是为了让人们不必点击我刚才所做的链接，这是Siddharth评论中的一个很棒的例子。
Option Explicit
Option Compare Text
' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
Dim lngFirst As Long
Dim lngLast As Long
Dim varMid As Variant
Dim varSwap As Variant
If plngRight = 0 Then
plngLeft = LBound(pvarArray)
plngRight = UBound(pvarArray)
End If
lngFirst = plngLeft
lngLast = plngRight
varMid = pvarArray((plngLeft + plngRight) \ 2)
Do
Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
lngFirst = lngFirst + 1
Loop
Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
lngLast = lngLast - 1
Loop
If lngFirst <= lngLast Then
varSwap = pvarArray(lngFirst)
pvarArray(lngFirst) = pvarArray(lngLast)
pvarArray(lngLast) = varSwap
lngFirst = lngFirst + 1
lngLast = lngLast - 1
End If
Loop Until lngFirst > lngLast
If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub
答案 2 :(得分：1)
我成功使用了Shell排序算法。使用VBA Rnd（）函数生成的数组测试N = 10000时，眨眼间运行 - 不要忘记使用Randomize语句生成测试数组。对于我正在处理的元素数量来说，它很容易实现，而且简短而有效。代码注释中给出了参考。
' Shell sort algorithm for sorting a double from largest to smallest.
' Adopted from "Numerical Recipes in C" aka NRC 2nd Edition p330ff.
' Speed is on the range of N^1.25 to N^1.5 (somewhere between bubble and quicksort)
' Refer to the NRC reference for more details on efficiency.
'
Private Sub ShellSortDescending(ByRef a() As Double, N As Integer)
' requires a(1..N)
Debug.Assert LBound(a) = 1
' setup
Dim i, j, inc As Integer
Dim v As Double
inc = 1
' determine the starting incriment
Do
inc = inc * 3
inc = inc + 1
Loop While inc <= N
' loop over the partial sorts
Do
inc = inc / 3
' Outer loop of straigh insertion
For i = inc + 1 To N
v = a(i)
j = i
' Inner loop of straight insertion
' switch to a(j - inc) > v for ascending
Do While a(j - inc) < v
a(j) = a(j - inc)
j = j - inc
If j <= inc Then Exit Do
Loop
a(j) = v
Next i
Loop While inc > 1
End Sub
答案 3 :(得分：0)
我知道OP指定不使用工作表，但值得注意的是创建一个新的WorkSheet，使用它作为便笺簿与工作表函数进行排序，然后清理后的时间长于不到2倍。但是您还可以通过Sort WorkSheet Function的参数提供所有灵活性。
在我的系统上，对于@ tannman357的非常好的递归例程和下面方法的96毫秒，差异为55毫秒。这是几次运行的平均时间。
Sub rangeSort(ByRef a As Variant)
Const myName As String = "Module1.rangeSort"
Dim db As New cDebugReporter
db.Report caller:=myName
Dim r As Range, va As Variant, ws As Worksheet
quietMode qmON
Set ws = ActiveWorkbook.Sheets.Add
Set r = ws.Cells(1, 1).Resize(UBound(a), 1)
r.Value2 = rangeVariant(a)
r.Sort Key1:=r.Cells(1), Order1:=xlDescending
va = r.Value2
GetColumn va, a, 1
ws.Delete
quietMode qmOFF
End Sub
Function rangeVariant(a As Variant) As Variant
Dim va As Variant, i As Long
ReDim va(LBound(a) To UBound(a), 0)
For i = LBound(a) To UBound(a)
va(i, 0) = a(i)
Next i
rangeVariant = va
End Function
Sub quietMode(state As qmState)
Static currentState As Boolean
With Application
Select Case state
Case qmON
currentState = .ScreenUpdating
If currentState Then .ScreenUpdating = False
.Calculation = xlCalculationManual
.DisplayAlerts = False
Case qmOFF
If currentState Then .ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
Case Else
End Select
End With
End Sub
答案 4 :(得分：0)
如果您想要高效算法，请查看Timsort。它是适应合并排序，解决了它的问题。
Case Timsort Introsort Merge sort Quicksort Insertion sort Selection sort
Best Ɵ(n) Ɵ(n log n) Ɵ(n log n) Ɵ(n) Ɵ(n^2) Ɵ(n)
Average Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2)
Worst Ɵ(n log n) Ɵ(n log n) Ɵ(n log n) Ɵ(n^2) Ɵ(n^2) Ɵ(n^2)
然而，1k - 10k数据条目的数据量太少，您无需担心内置的搜索效率。
示例：如果您的数据来自 A到D 列，标题位于第2行，并且您希望按 B列排序。
Dim lastrow As Long
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Range("A3:D" & lastrow).Sort key1:=Range("B3:B" & lastrow), _
order1:=xlAscending, Header:=xlNo
答案 5 :(得分：0)
很久以前，我自己回答了这个问题，这意味着我不得不回到我的第一个VBA存档文件。 因此，我找到了这本旧代码，该书是我从书中摘下来的。 首先，它将值（从与表列相交的选择中保存）到数组ar（x），然后从最小到最大对它们进行排序。 要排序2个泡，第一个泡（Do Loop直到sw = 0）和第二个泡（对于x = 1 To n Next）比较值a（x）和值a（x + 1），保持在a（ x）最大数，而ar（x + 1）最小。 第一个小泡重复直到从最小到最大的排序。 我实际上使用此代码在预算列（TblPpto [Descripcion]）中的每个选定单元格上方插入一行。 希望对您有帮助！
Sub Sorting()
Dim ar() As Integer, AX As Integer
Set rng = Intersect(Selection, Range("TblPpto[Descripcion]")) 'Cells selected in Table column
n = rng.Cells.Count 'Number of rows
ReDim ar(1 To n)
x = 1
For Each Cell In rng.Cells
ar(x) = Cell.Row 'Save rows numbers to array ar()
x = x + 1
Next
Do 'Sort array ar() values
sw = 0 'Condition to finish bucle
For x = 1 To n - 1
If ar(x) > ar(x + 1) Then 'If ar(x) is bigger
AX = ar(x) 'AX gets bigger number
ar(x) = ar(x + 1) 'ar(x) changes to smaller number
ar(x + 1) = AX 'ar(x+1) changes to bigger number
sw = 1 'Not finished sorting
End If
Next
Loop Until sw = 0
'Insert rows in TblPpto
fila = Range("TblPpto[#Headers]").Row
For x = n To 1 Step -1
[TblPpto].Rows(ar(x) - fila).EntireRow.Insert
Next x
End Sub
答案 6 :(得分：-1)
trincot 代码简单地扩展为函数。 玩得开心！
Function sort1DimArray(thatArray As Variant, descending As Boolean) As Variant
Dim arr As Object, i As Long, j As Long`
Set arr = CreateObject("System.Collections.ArrayList")
For i = LBound(thatArray) To UBound(thatArray)
arr.Add thatArray(i)
Next i
arr.Sort
If descending = True Then
arr.Reverse
End If
'shortens empty spaces
For i = 0 To (arr.count - 1)
If Not IsEmpty(arr.Item(i)) Then
thatArray(j) = arr.Item(i)
j = j + 1
End If
Next i
ReDim Preserve thatArray(0 To (j - 1))
sort1DimArray = thatArray
End Function