Sortering af data i et Array med VBA - TILLÆG

cddk -> vis lige funktionen :-)

Public Function 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, 1) = FirstCell.Offset(i - 1, 0)
    Next i
    Application.DisplayAlerts = False
    wshTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Function

taget fra "biblen" kap. 11  :-)
Kigger på den, men vender først tilbage i aften ....

Ok, du får den lige alligevel. Den er ikke fejlsikret, men den virker. Pas dog på med datoer. Sub'en er kun med for at teste

Public Function WorksheetSort(list) As Variant
   
    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, 1) = FirstCell.Offset(i - 1, 0)
    Next i
    Application.DisplayAlerts = False
    wshTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    WorksheetSort = list
End Function

Sub test_sortering()
Dim x As Variant
Dim t As Variant
x = Range("A1:A50")
t = WorksheetSort(x)
Range("AA1:AA50") = t
End Sub