15

以降序对数字数组（1000-10000 个数字，但可能会有所不同）进行排序的最快方法（就计算时间而言）是什么？据我所知，Excel 内置函数效率不高，内存排序应该比 Excel 函数快很多。

请注意，我无法在电子表格上创建任何内容，所有内容都必须仅在内存中存储和排序。

4

7 回答 7

10

你可以使用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

这使用快速排序。

于 2015-12-03T22:13:00.907 回答
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
于 2014-06-21T11:41:56.023 回答
1

如果您想要高效的算法，请查看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
于 2014-09-26T08:21:34.420 回答
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
于 2016-09-26T15:43:48.323 回答
0

我知道 OP 指定不使用工作表，但值得注意的是，创建一个新的 WorkSheet，将其用作便笺簿以使用工作表功能进行排序，然后清理的时间长不到 2 倍。但你也有排序工作表函数的参数提供的所有灵活性。

在我的系统上，@tannman357 非常好的递归例程的差异是 55 毫秒，而下面的方法的差异是 96 毫秒。这些是几次运行的平均时间。

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
于 2014-08-26T15:41:45.610 回答
0

很久以前我自己回答了这个问题，这意味着我不得不回到我的第一个 VBA 存档文件。所以我找到了这个旧代码，它是从一本书中摘录的。首先，它将值（从与表列相交的选择中）保存到数组 ar(x) 中，然后将它们从小到大排序。排序有 2 个 bucles，第一个（Do Loop Until sw=0）和第二个（For x=1 To n Next）比较值 a(x) 和值 a(x+1)，保持在 a( x) 最大的数和 ar(x+1) 中的最小数。第一个 bucle 重复，直到从最小到最大排序。我实际上使用此代码在预算列中的每个选定单元格上方插入一行（TblPpto [描述]）。希望能帮助到你！

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
于 2018-06-28T05:10:52.477 回答
0

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
于 2021-02-23T13:58:43.373 回答