Hallo,
mit dem nachstehenden Code werden die alle Daten, die mit dem Namen "Daten" benannt worden sind, sortiert und in der Tabelle2, Spalte 1 in aufsteigender Reihenfolge eingetragen:
Sub SortData()
Dim rng As Range, cl As Range
Dim data() As Double
Dim iCnt As Integer
Set rng = ActiveWorkbook.Names("Daten").RefersToRange
iCnt = -1
For Each cl In rng.Cells
iCnt = iCnt + 1
ReDim Preserve data(iCnt)
data(iCnt) = Val(cl.Formula)
Next
' Sort Data
QuickSort data, 0, UBound(data)
' Eintragen in Spalte A der Tabelle 2
InsertData data, 1
End Sub
Sub InsertData(ByRef arData As Variant, iColumn As Integer)
Dim sh As Worksheet
Dim vItem As Variant
Dim iRw As Integer
Set sh = ActiveWorkbook.Worksheets("Tabelle2")
For Each vItem In arData
iRw = iRw + 1
sh.Cells(iRw, iColumn).FormulaR1C1 = vItem
Next
End Sub
' Quelle: https://msdn.microsoft.com/de-de/library/bb979305.aspx
Private Sub QuickSort( _
ByRef ArrayToSort As Variant, _
ByVal Low As Long, _
ByVal High As Long)
Dim vPartition As Variant, vTemp As Variant
Dim i As Long, j As Long
If Low > High Then Exit Sub ' Rekursions-Abbruchbedingung
' Ermittlung des Mittenelements zur Aufteilung in zwei Teilfelder:
vPartition = ArrayToSort((Low + High) \ 2)
' Indizes i und j initial auf die äußeren Grenzen des Feldes setzen:
i = Low: j = High
Do
' Von links nach rechts das linke Teilfeld durchsuchen:
Do While ArrayToSort(i) < vPartition
i = i + 1
Loop
' Von rechts nach links das rechte Teilfeld durchsuchen:
Do While ArrayToSort(j) > vPartition
j = j - 1
Loop
If i <= j Then
' Die beiden gefundenen, falsch einsortierten Elemente
austauschen:
vTemp = ArrayToSort(j)
ArrayToSort(j) = ArrayToSort(i)
ArrayToSort(i) = vTemp
i = i + 1
j = j - 1
End If
Loop Until i > j ' Überschneidung der Indizes
' Rekursive Sortierung der ausgewählten Teilfelder. Um die
' Rekursionstiefe zu optimieren, wird (sofern die Teilfelder
' nicht identisch groß sind) zuerst das kleinere
' Teilfeld rekursiv sortiert.
If (j - Low) < (High - i) Then
QuickSort ArrayToSort, Low, j
QuickSort ArrayToSort, i, High
Else
QuickSort ArrayToSort, i, High
QuickSort ArrayToSort, Low, j
End If
End Sub
VG, BigBen
|