sorter array efter dato

Ska' du bruge en sorteringsalgoritme. ?

ja

fant selv en løsning:

' QSort2
'
' This version sorts a 2-dimensional array on the iIdx column
' Performance on a P233MMX with 64M of RAM:
' ~55 seconds to sort 100,000 rows of random integers.
'
' Parameters:
'
' aData    array to be sorted
' iIdx  index of column to use for sorting
' iLb  lower-bound of elements to be sorted
' iUb  upper-bound of elements to be sorted
'
' e.g. QSort2(aData, 0, 0, ubound(aData)) ' sort the entire array based on column 0
'      QSort2(aData, 3, 3, 8) ' sort elements from index 3 to 8 based on column 3

Public Sub QSort2(aData, iIdx, iLb, iUb)
Dim lbStack(32)
Dim ubStack(32)
Dim sp              ' stack pointer
Dim iLbx            ' current lower-bound
Dim iUbx            ' current upper-bound
Dim m
Dim p              ' index to pivot
Dim i
Dim j
Dim t              ' temp used for exchanges

lbStack(0) = iLb
ubStack(0) = iUb
sp = 0
Do While sp >= 0
  iLbx = lbStack(sp)
  iUbx = ubStack(sp)

  Do While (iLbx < iUbx)

  ' select pivot and exchange with 1st element
  p = iLbx + (iUbx - iLbx) \ 2

  ' exchange iLbx, p
  Swap aData, iLbx, p

  ' partition into two segments
  i = iLbx + 1
  j = iUbx
  Do
    Do While i < j
    If aData(iLbx, iIdx) <= aData(i, iIdx) Then Exit Do
    i = i + 1
    Loop

    Do While j >= i
    If aData(j, iIdx) <= aData(iLbx, iIdx) Then Exit Do
    j = j - 1
    Loop

    If i >= j Then Exit Do

    ' exchange i, j
    Swap aData, i, j

    j = j - 1
    i = i + 1
  Loop

  ' pivot belongs in aData[j]
  ' exchange iLbx, j
  Swap aData, iLbx, j
 
  m = j

  ' keep processing smallest segment, and stack largest
  If m - iLbx <= iUbx - m Then
    If m + 1 < iUbx Then
    lbStack(sp) = m + 1
    ubStack(sp) = iUbx
    sp = sp + 1
    End If
    iUbx = m - 1
  Else
    If m - 1 > iLbx Then
    lbStack(sp) = iLbx
    ubStack(sp) = m - 1
    sp = sp + 1
    End If
    iLbx = m + 1
  End If
  Loop
  sp = sp - 1
Loop
End Sub

' ======================================================================
'
' Swap()
'
' Used by QSort2, this sub swaps two rows in a 2 dimensional array
'
' Parameters:
'
' aData    array to work with
' iRow1    index of first row
' iRow2    index of second row
'
' e.g. Swap(A, 3, 8) ' swap the 4th and 9th rows in A.

Public Sub Swap(aData, iRow1, iRow2)
Dim i, tmp

' Get values into Tmp
For i = 0 to Ubound(aData, 2)
  tmp = aData(iRow1, i)
  aData(iRow1, i) = aData(iRow2, i)
  aData(iRow2, i) = tmp
Next
End Sub

' ======================================================================
'
' Transpose()
'
' Changes the data in a two dimensional array from:
' (x,y) => (y,x).  This can be useful if you don't
' like the way RECORDSET.getrows() works.  Calling
' Transpose() is a quick way to get your array into
' the proper form for QSort2().
'
' Parameters:
'
' aData    array to be transposed
'
' Returns:
'
' New transposed array.
'
' Performance on a P233MMX with 64M of RAM:
' ~5 seconds to transpose 100,000 rows.
'
' e.g. a2 = Transpose(a1)

Public Function Transpose(aData)
Dim i, j, aTmp

' Dimension Tmp the opposite of A
Redim aTmp(ubound(aData, 2), ubound(aData))

' Transpose
For i = 0 to ubound(aData, 2)
  For j = 0 to ubound(aData)
  aTmp(i, j) = aData(j, i)
  Next
Next

Transpose = aTmp
End Function

Den ser lang og svær ud. :-)

ja men der er hjælp at finde i de kommentare som fælger med :)