Excel VBA 숫자 배열을 내림차순으로 정렬하는 가장 빠른 방법은 무엇입니까?

Excel VBA 숫자 배열을 내림차순으로 정렬하는 가장 빠른 방법은 무엇입니까?

숫자 배열(1000-10000 숫자이지만 다를 수 있음)을 내림차순으로 정렬하는 가장 빠른 방법은 무엇입니까?제가 알기로는 엑셀 내장 기능은 그다지 효율적이지 않고 메모리 내 정렬이 엑셀 기능보다 훨씬 빠를 것으로 알고 있습니다.

스프레드시트에는 아무것도 만들 수 없습니다. 모든 것은 메모리에만 저장하고 정렬해야 합니다.

다음을 사용할 수 있습니다.

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

빠른 정렬을 사용합니다.

사람들이 제가 방금 한 링크를 클릭할 필요가 없도록, 여기 싯다스의 논평에서 나온 환상적인 예가 있습니다.

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

효율적인 알고리즘을 원한다면 팀소트를 살펴보십시오.문제를 해결하는 것은 병합 정렬의 적응입니다.

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

셸 정렬 알고리즘을 성공적으로 사용했습니다.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

나는 워크시트를 사용하지 않도록 OP가 지정된 것을 알고 있지만 새 워크시트를 만들고 워크시트 기능으로 정렬하기 위해 스크래치 패드로 사용한 후 정리하는 것이 2배 미만으로 길다는 점에 주목할 필요가 있습니다.그러나 워크시트 정렬 기능의 매개 변수를 통해 모든 유연성을 제공할 수 있습니다.

제 시스템에서는 @tannman357에 의한 매우 멋진 재귀 루틴의 경우 55msec, 아래 방법의 경우 96msec의 차이가 있었습니다.이는 여러 번의 런에 걸친 평균 시간입니다.

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

저는 오래 전에 이 질문에 직접 답했습니다. 즉, 첫 번째 VBA 아카이브 파일로 돌아와야 했습니다.그래서 저는 책에서 가져온 이 오래된 코드를 찾았습니다.먼저 값을 (테이블 열과 교차된 선택에서) 배열 ar(x)로 저장한 다음 가장 작은 값에서 가장 큰 값으로 정렬합니다.두 개의 버스를 정렬하려면 첫 번째 버스(Do Loop Entil sw=0)와 두 번째 버스(x=1 Ton Next의 경우)가 a(x) 값과 a(x+1) 값을 비교하여 a(x) 가장 큰 수와 ar(x+1) 가장 작은 수를 유지합니다.첫 번째 부클은 가장 작은 형태에서 가장 큰 형태로 정렬될 때까지 반복됩니다.저는 실제로 이 코드를 사용하여 예산 열(TblPpto[Description])에서 선택한 모든 셀 위에 행을 삽입했습니다.도움이 되길 바랍니다!

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

트린콧 코드는 단순히 함수로 확장되었습니다.재미있게 놀아요!

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

언급URL : https://stackoverflow.com/questions/11504418/excel-vba-quickest-way-to-sort-an-array-of-numbers-in-descending-order