Felder über VBA sortieren

Sub SortArray() Dim arr(1 To 4) Dim iCounter As Integer, iCount As Integer, iTemp As Integer arr(1) = 9: arr(2) = 7: arr(3) = 15: arr(4) = 1 For iCounter = 1 To 4 For iCount = iCounter + 1 To 4 If arr(iCounter) > arr(iCount) Then iTemp = arr(iCounter) arr(iCounter) = arr(iCount) arr(iCount) = arr(iTemp) 'hier tritt der Fehler auf End If Next iCount Next iCounter For iCounter = 1 To 4 MsgBox prompt:=arr(iCounter) Next iCounter End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub test() Dim varArrav(1 To 65536, 1 To 1) As Variant, lngIndex As Long, lngzaehler As Long For lngIndex = 131072 To 2 Step -2 lngzaehler = lngzaehler + 1 varArrav(lngzaehler, 1) = lngIndex Next Call sortieren(1, 65536, varArrav) Range(Cells(1, 1), Cells(65536, 1)) = varArrav End Sub Private Sub sortieren(lngUgrenze As Long, lngOgrenze As Long, varFeld) Dim lngIndex1 As Long, lngIndex2 As Long, lngElement As Long, lngSpeicher As Long lngIndex1 = lngUgrenze lngIndex2 = lngOgrenze lngSpeicher = varFeld(((lngUgrenze + lngOgrenze) / 2) \ 1, 1) Do Do While varFeld(lngIndex1, 1) < lngSpeicher lngIndex1 = lngIndex1 + 1 Loop Do While lngSpeicher < varFeld(lngIndex2, 1) lngIndex2 = lngIndex2 - 1 Loop If lngIndex1 <= lngIndex2 Then lngElement = varFeld(lngIndex1, 1) varFeld(lngIndex1, 1) = varFeld(lngIndex2, 1) varFeld(lngIndex2, 1) = lngElement lngIndex1 = lngIndex1 + 1 lngIndex2 = lngIndex2 - 1 End If Loop Until lngIndex1 > lngIndex2 If lngUgrenze < lngIndex2 Then Call sortieren(lngUgrenze, lngIndex2, varFeld) If lngIndex1 < lngOgrenze Then Call sortieren(lngIndex1, lngOgrenze, varFeld) End Sub

Private Sub CommandButton1_Click() Dim arr As Variant Dim i As Integer Dim iCounter As Integer, iCount As Integer, iTemp As Integer i = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row arr = Worksheets(1).Range("A1:A" & i) For iCounter = 1 To i For iCount = iCounter + 1 To 4 If arr(iCounter) > arr(iCount) Then 'Laufzeitfehler iTemp = arr(iCounter) arr(iCounter) = arr(iCount) arr(iCount) = iTemp End If Next iCount Next iCounter ' TextBox1.Value = UBound(arr) ComboBox1.List() = arr End Sub

Hallo Wolf,

1. Nein, das spielt für den Sortiervorgang keine Rolle. Das sortieren geschieht im Arbeitsspeicher und dort stehen keine Buchstaben sondern die Asciiwerte der Buchstaben in hexadezimaler Form. Also, an Stelle von "Hallo" steht dort in Ascii: 72|97|108|108|111 und davon die hexadezimalwerte: 48616C6C6F dieser Wert wird sortiert. Die Grafikkarte macht aus diesem Zahlensalat erst das Wort "Hallo". Aber Achtung, sollten sich Zahlen in dem Variantfeld befinden, so werden sie nicht mehr nummerisch sortiert, sondern Alphanummerisch. Also nicht 1, 2, 3, 4, 10, 11, 20, 21 ..... sondern 1, 10, 11, 2, 20, 21, 22, 3, 30, 31 ..........

2. Wenn du eine Spalte in ein Variantarray einliest, dann ist das Array zweidimensional, auch wenn es nur eine Spalte besitzt. Der erste Eintrag hat dann die Adresse 1,1 der zweite 2,1 usw.

3. Wenn du eine Spalte in einen Variant einliest, kannst du nie sicher sein, dass es nicht mehr wie 32.767 Zeilen sind. Darum ist es sicherer, wenn du an Stelle des Datentyps Integer den Datentyp Long verwendest.

4. In der For - Next - Anweisung der zweiten Schleife ist noch ein Fehler, da du dort nur vier Werte sortieren lässt.

5. iTemp muss jetzt nicht nur Zahlen sondern Strings aufnehmen. Darum muss sie mindestens als String deklariert werden, sonst hast du sofort den nächsten Fehler. Da du sie mit Variant - Daten belegst, deklariere sie auch als Variant.

6. Versuche dir von haus aus die Deklaration von sprechenden Variablen anzugewöhnen. Nicht nur einfach i. Wenn du einmal ein größeres Projekt entwickelst, welches mehrere hundert oder tausend Programmzeilen umfasst, gehen dir ersten ziemlich schnell die Buchstaben aus und nach einem Monat, wenn du etwas korrigieren musst, kannst du in Zeile 1798 nicht mehr sagen, was war x oder y oder z.

Dein Programm sollte nun so aussehen:


Option Explicit
Private Sub CommandButton1_Click()
Dim vArray As Variant
Dim lZeile As Long
Dim lCounter As Long, lCount As Long, vTemp As Variant
lZeile = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
vArray = Worksheets(1).Range("A1:A" & CStr(lZeile))
For lCounter = 1 To lZeile
For lCount = lCounter + 1 To lZeile
If vArray(lCounter, 1) > vArray(lCount, 1) Then
vTemp = vArray(lCounter, 1)
vArray(lCounter, 1) = vArray(lCount, 1)
vArray(lCount, 1) = vTemp
End If
Next lCount
Next lCounter
ComboBox1.List() = vArray
End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß
Nepumuk

Option Explicit Private Sub CommandButton1_Click() Dim varArrav With Worksheets(1) varArrav = .Range(.Cells(1, 1), .Cells(.Cells(65536, 1).End(xlUp).Row, 1)) End With Call sortieren(1, UBound(varArrav), varArrav) ComboBox1.List = varArrav End Sub Private Sub sortieren(lngUgrenze As Long, lngOgrenze As Long, varFeld) Dim lngIndex1 As Long, lngIndex2 As Long, varElement As Variant, varSpeicher As Variant lngIndex1 = lngUgrenze lngIndex2 = lngOgrenze varSpeicher = varFeld(((lngUgrenze + lngOgrenze) / 2) \ 1, 1) Do Do While varFeld(lngIndex1, 1) < varSpeicher lngIndex1 = lngIndex1 + 1 Loop Do While varSpeicher < varFeld(lngIndex2, 1) lngIndex2 = lngIndex2 - 1 Loop If lngIndex1 <= lngIndex2 Then varElement = varFeld(lngIndex1, 1) varFeld(lngIndex1, 1) = varFeld(lngIndex2, 1) varFeld(lngIndex2, 1) = varElement lngIndex1 = lngIndex1 + 1 lngIndex2 = lngIndex2 - 1 End If Loop Until lngIndex1 > lngIndex2 If lngUgrenze < lngIndex2 Then Call sortieren(lngUgrenze, lngIndex2, varFeld) If lngIndex1 < lngOgrenze Then Call sortieren(lngIndex1, lngOgrenze, varFeld) End Sub

Hallo Nepumuk,

Geschwindigkeitsoptimierung bei 4.000 Datensätzen: ~ 60 sec Bubblesort-Methode, ~1 sec andere Methode.

Es ist schon seltsam, aber es kommen immer wieder neue Fragen bei mir auf.

Ich möchte jedoch nicht unverschämt oder zu aufdringlich sein. Daher kann ich es gut verstehen, wenn Du meine letzten beiden Fragen nicht beantwortest.

Auf jeden Fall vielen Dank für die professionelle Hilfe.

Wenn der in das Array einzulesende Worksheet-Bereich nun Von Spalte A bis Spalte D geht, verändert sich der Code zu

With Worksheets(1)
varArrav = .Range(.Cells(1, 1), .Cells(.Cells(65536, 1).End(xlUp).Row, 5))
End With

Das Sortieren-Makro funktioniert zwar, aber sortiert nur die Daten in Spalte A, die Werte in den Nachbar-Bereichen werden nicht nachgeführt.

1. Wie kann man erreichen, dass der ganze Datensatz (Zeile) sortiert wird?

2. Welcher Parameter ist verantwortlich, dass nach dem dritten Feld (Spalte C) innerhalb eines Datensatzes sortiert werden soll?

Gruß Lupus

Option Explicit Private Sub CommandButton1_Click() Dim varArrav With Worksheets(1) varArrav = .Range(.Cells(1, 1), .Cells(.Cells(65536, 1).End(xlUp).Row, 5)) 'die kennst du ja End With Call sortieren(1, UBound(varArrav), varArrav) ComboBox1.List = varArrav End Sub Private Sub sortieren(lngUgrenze As Long, lngOgrenze As Long, varFeld) Dim lngIndex1 As Long, lngIndex2 As Long, varElement As Variant, varSpeicher As Variant, intSpalte As Integer lngIndex1 = lngUgrenze lngIndex2 = lngOgrenze varSpeicher = varFeld(((lngUgrenze + lngOgrenze) / 2) \ 1, 1) 'der Wert hinter dem Komma ist die Spalte die sortiert wird Do Do While varFeld(lngIndex1, 1) < varSpeicher 'der Wert hinter dem Komma ist die Spalte die sortiert wird lngIndex1 = lngIndex1 + 1 Loop Do While varSpeicher < varFeld(lngIndex2, 1) 'der Wert hinter dem Komma ist die Spalte die sortiert wird lngIndex2 = lngIndex2 - 1 Loop If lngIndex1 <= lngIndex2 Then For intSpalte = 1 To 5 '5 Spalten übertragen varElement = varFeld(lngIndex1, intSpalte) varFeld(lngIndex1, intSpalte) = varFeld(lngIndex2, intSpalte) varFeld(lngIndex2, intSpalte) = varElement Next lngIndex1 = lngIndex1 + 1 lngIndex2 = lngIndex2 - 1 End If Loop Until lngIndex1 > lngIndex2 If lngUgrenze < lngIndex2 Then Call sortieren(lngUgrenze, lngIndex2, varFeld) If lngIndex1 < lngOgrenze Then Call sortieren(lngIndex1, lngOgrenze, varFeld) End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread