एक्सेल वीबीए अवरोही क्रम में संख्याओं की सरणी को सॉर्ट करने का सबसे तेज़ तरीका?

Question

अवरोही क्रम में संख्याओं की एक सरणी (1000-10000 संख्याएं लेकिन भिन्न हो सकती हैं) को क्रमबद्ध करने के लिए सबसे तेज़ तरीका (कम्प्यूटेशनल समय के संदर्भ में) क्या है? जहां तक ​​मुझे पता है कि एक्सेल बिल्ड-इन फ़ंक्शंस वास्तव में कुशल नहीं है और इन-मेमोरी सॉर्टिंग एक्सेल फ़ंक्शंस की तुलना में बहुत तेज होनी चाहिए।

ध्यान दें कि मैं स्प्रेडशीट पर कुछ भी नहीं बना सकता, सबकुछ केवल स्मृति में संग्रहीत और क्रमबद्ध होना है।

Answer 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 

Answer 2

मैं ओपी निर्दिष्ट कार्यपत्रकों लेकिन इसके लायक टिप्पण एक नया वर्कशीट बनाने कि, एक स्क्रैच पैड के रूप में उपयोग वर्कशीट कार्यों के साथ तरह करने के लिए उपयोग नहीं कर पता है, तो एक से भी कम समय पहलू से सफाई लंबे समय तक हो जाने के बाद 2. लेकिन आपके पास सॉर्ट वर्कशीट फ़ंक्शन के पैरामीटर द्वारा वितरित सभी लचीलापन भी है।

मेरे सिस्टम पर, अंतर नीचे विधि के लिए @ tannman357 और 96 msec द्वारा बहुत अच्छी रिकर्सिव रूटीन के लिए 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 

Answer 3

आप कुशल एल्गोरिथ्म चाहते हैं, तो 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 डेटा प्रविष्टियों आप खोज दक्षता में बनाया बारे में चिंता करने के लिए डेटा के अब तक बहुत कम राशि है।

---

उदाहरण: यदि आप डी करने से स्तंभ एक डेटा है और शीर्ष लेख पंक्ति 2 पर है और आप द्वारा स्तंभ बी सॉर्ट करने के लिए चाहते हैं।

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 

Answer 4

आप 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 

इस का उपयोग करता है त्वरित क्रमबद्ध।

Answer 5

मैंने शैल सॉर्ट एल्गोरिदम सफलतापूर्वक उपयोग किया है। वीबीए आरएनडी() फ़ंक्शन के साथ उत्पन्न सरणी का उपयोग करते हुए एन = 10000 के लिए परीक्षण किए जाने पर आंख की झपकी में भागता है - परीक्षण सरणी उत्पन्न करने के लिए यादृच्छिक विवरण का उपयोग करना न भूलें। उन तत्वों की संख्या के लिए लागू करना आसान और छोटा और कुशल था जो मैं कर रहा था। कोड टिप्पणियों में संदर्भ दिया गया है।

' 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