Sortering af data i et Array med VBA

Her er et quicksort modul du kan bruge (det er meget hurtigere end boblesort når der er mange data), men faktisk er det lige så hurtigt at oprette et midlertidig ark, smide dit array ind på det, bruge excel's egen sortering (lynende hurtigt) og derefter henter det tilbage



Sub Quicksort(values(), ByVal min As Long, ByVal max As Long)

  Dim med_value As String
  Dim hi As Long
  Dim lo As Long
  Dim i As Long

  ' If the list has only 1 item, it's sorted.
  If min >= max Then Exit Sub

  ' Pick a dividing item randomly.
  i = min + Int(Rnd(max - min + 1))
  med_value = values(i)

  ' Swap the dividing item to the front of the list.
  values(i) = values(min)

  ' Separate the list into sublists.
  lo = min
  hi = max
  Do
    ' Look down from hi for a value < med_value.
    Do While values(hi) >= med_value
      hi = hi - 1
      If hi <= lo Then Exit Do
    Loop

    If hi <= lo Then
      ' The list is separated.
      values(lo) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(lo) = values(hi)

    ' Look up from lo for a value >= med_value.
    lo = lo + 1
    Do While values(lo) < med_value
      lo = lo + 1
      If lo >= hi Then Exit Do
    Loop

    If lo >= hi Then
      ' The list is separated.
      lo = hi
      values(hi) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(hi) = values(lo)
  Loop ' Loop until the list is separated.

  ' Recursively sort the sublists.
  Quicksort values, min, lo - 1
  Quicksort values, lo + 1, max

End Sub

her er lige et modul til til det med at bruge excels egen sortering


Sub WorksheetSort(list)
   
    Dim First As Integer, Last As Long
    Dim i As Long
    Dim FirstCell As Range, LastCell As Range
    Dim CurrCell As Range, FillRange As Range
    Dim wshTemp As Worksheet
    Set wshTemp = Worksheets.Add
   
    First = LBound(list, 1)
    Last = UBound(list, 1)
   
    Set FirstCell = wshTemp.Cells(1, 1)
    Set LastCell = wshTemp.Cells(Last, 1)
    Set FillRange = wshTemp.Range(FirstCell, LastCell)
    Application.ScreenUpdating = False
   
'  Transfer the array to worksheet
    FillRange.Value = list
   
'  Sort the worksheet range
    FirstCell.CurrentRegion.Sort Key1:=FirstCell, Order1:=xlAscending, Orientation:=xlTopToBottom
     
'  Transfer range back to the array and clear range
    For i = First To Last
        list(i, 0) = FirstCell.Offset(i - 1, 0)
    Next i
    Application.DisplayAlerts = False
    wshTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

virker den første makro også på et array som (4000,4) husk det er kun den første række der skal sorteres.

Skal resten af værdierne ikke sorteres med ?

det er ikke nødvendigt...

ok bambus, denne sorterer dit array efter 1 række

Sub Quicksort(values(), min, max)
  Dim med_value
  Dim hi As Long
  Dim lo As Long
  Dim i As Long

  ' If the list has only 1 item, it's sorted.
  If min >= max Then Exit Sub

  ' Pick a dividing item randomly.
  i = min + Int(Rnd(max - min + 1))
  med_value = values(i, 1)

  ' Swap the dividing item to the front of the list.
  values(i, 1) = values(min, 1)

  ' Separate the list into sublists.
  lo = min
  hi = max
  Do
    ' Look down from hi for a value < med_value.
    Do While values(hi, 1) >= med_value
      hi = hi - 1
      If hi <= lo Then Exit Do
    Loop

    If hi <= lo Then
      ' The list is separated.
      values(lo, 1) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(lo, 1) = values(hi, 1)

    ' Look up from lo for a value >= med_value.
    lo = lo + 1
    Do While values(lo, 1) < med_value
      lo = lo + 1
      If lo >= hi Then Exit Do
    Loop

    If lo >= hi Then
      ' The list is separated.
      lo = hi
      values(hi, 1) = med_value
      Exit Do
    End If

    ' Swap the lo and hi values.
    values(hi, 1) = values(lo, 1)
  Loop ' Loop until the list is separated.

  ' Recursively sort the sublists.
  Quicksort values, min, lo - 1
  Quicksort values, lo + 1, max

End Sub

okay bak men du må lige hjælpe mig lidt...
Values() er = mit Array(4000,1) eller?...
jeg har en textbox, og hvergang der sker en ændring skal der sorteres

values()= mit_array(4000,3)
men det er kun første kolonne der sorteres altså mit_array(4000,1)

bruges sådan
Call quicksort(mit_array,1,4000)

Super kører helt perfekt!

Ok, men kører den også hurtigere som jeg påstod??  :-)

ja det må siges