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 のコメントからの素晴らしい例の 1 つを示します。

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がワークシートを使用しないように指定されていることは知っていますが、新しいワークシートを作成し、それをスクラッチパッドとして使用してワークシート関数で並べ替えを行い、その後のクリーンアップが2倍未満長くなることは注目に値します。 Sort WorkSheet 関数のパラメーターによって提供されるすべての柔軟性。

私のシステムでは、@ 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 に答える