Array sortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jochen,
wenn's nicht mehr ist:

Option Explicit
Public Sub proc_fuellen()
    Dim dblArray(1 To 1000, 1 To 100) As Double
    Dim intZeilen As Integer, intSpalten As Integer
    For intSpalten = 1 To 1000
        For intZeilen = 1 To 100
            dblArray(intSpalten, intZeilen) = 101 - intZeilen
        Next
    Next
    Call proc_sortieren(1, 100, dblArray())
End Sub
Private Sub proc_sortieren(intUGrenze As Integer, intOGrenze As Integer, dblArray() As Double)
    Dim intIndex1 As Integer, intIndex2 As Integer, intSpalte As Integer
    Dim dblElement As Double, dblSpeicher As Double
    intIndex1 = intUGrenze
    intIndex2 = intOGrenze
    dblSpeicher = dblArray(1, Fix(intUGrenze + intOGrenze) / 2)
    Do
        Do While dblArray(1, intIndex1) < dblSpeicher
            intIndex1 = intIndex1 + 1
        Loop
        Do While dblSpeicher < dblArray(1, intIndex2)
            intIndex2 = intIndex2 - 1
        Loop
        If intIndex1 <= intIndex2 Then
            For intSpalte = 1 To 1000
                dblElement = dblArray(intSpalte, intIndex1)
                dblArray(intSpalte, intIndex1) = dblArray(intSpalte, intIndex2)
                dblArray(intSpalte, intIndex2) = dblElement
            Next
            intIndex1 = intIndex1 + 1
            intIndex2 = intIndex2 - 1
        End If
    Loop Until intIndex1 > intIndex2
    If intUGrenze < intIndex2 Then Call proc_sortieren(intUGrenze, intIndex2, dblArray())
    If intIndex1 < intOGrenze Then Call proc_sortieren(intIndex1, intOGrenze, dblArray())
End Sub

Gruß
Nepumuk

Liebste K.Rola,
für dich tu ich doch fast alles. Die Methode eignet sich auch für große Datenbestände.

Option Explicit
Option Base 0
'Deklaration eines Variant der das zusortierende Array aufnimmt.
'Das Array beinhaltet hier 16 Element (0 bis 15), wobei das erste
'als Hilfselement eingesetzt wird.
Dim SortArr As Variant
'Diese Prozedur initialisiert das Array mit den unsortierten Werten.
'Das Hilfselement SortArr(0) wird mit 0 initialisiert.
Sub Init_Arr(ByRef SortArr)
    SortArr = Array(0, 10, 3, 14, 5, 2, 13, 11, 9, 12, 1, 7, 15, 8, 4, 6)
End Sub
'Die Sortier-Prozedur Insert_Sort setzt den Sortieralgortihmus um.
Sub Insert_Sort(ByRef SortArr)
    Dim i As Integer, j As Integer, Element As Integer
    'Durchlaufen der Array-Elemente mittels Schleife.
    For i = 2 To 15
        Element = SortArr(i)
        'Hilfselement wird als Zwischenspeicher eingesetzt.
        SortArr(0) = Element
        j = i - 1
        'Verschieben der Array-Elemente bis
        'kleineres Array-Element gefunden.
        Do While Element < SortArr(j)
           SortArr(j + 1) = SortArr(j)
           j = j - 1
        Loop
        'Array-Element einfügen.
        SortArr(j + 1) = Element
    Next i
End Sub
'Über diese Prozedur kann das Array zur Überprüfung ausgegeben werden.
Sub ArrAusgabe(Text As String, ByRef SortArr)
    Dim i As Integer
    Dim SortArrStr As String

    SortArrStr = Text & SortArr(1)
    For i = 2 To 15
        SortArrStr = SortArrStr & ", " & SortArr(i)
    Next i
    MsgBox SortArrStr
End Sub
'Die Hauptprozedur führt die vorab aufgeführten Prozeduren aus.
Sub Insert_Sort_Test()
    Call Init_Arr(SortArr)
    Call ArrAusgabe("Unsortiert: ", SortArr)
    Call Insert_Sort(SortArr)
    Call ArrAusgabe("Sortiert: ", SortArr)
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread