Hallo Profis,
habe in einer Excel Tabelle z.B. 10x10 Zellen mit Daten und möchte diese (zeilenweise) auf Gleichheit (NICHT nur alphabetisch!) sortieren. Zunächst soll nach Spalte A, dann nach B usw. sortiert werden, jedoch ohne dass die Zeile verändert wird und so, dass so wenig wie möglich Werte-Wechsel zwischen den Zeilen vorkommen.
Die "normale" Sortierfunktion von Excel oder anderer Ausführungen im Netz reicht hier leider nicht aus da folgender "Sortierfehler" auftritt (siehe Bsp)
Mit dem Code den ich bisher programmiert habe kann ich wie Excel auch sortieren, jedoch nach beliebiger Anzahl an Spalten. Jedoch soll das Programm verfeinert werden um so gleiche Elemente in der Matrix zusammen bringen. (Code am Ende)
Würde mich über jede Anregung freuen!!!!!
Gruß Sebas
Bsp: unsortiert
a c
a a
b b
b c
a b
b a
Bsp: nach Excel Sortierweise:
a a
a b
a c
b a
b b
b c
Bsp: nach Gleichheit sortieren
-> im Vergleich zu Excel-Weise ist hier Zeile 4 mit 6 vertauscht und somit sind die C's zusammen :)
a a
a b
a c
b c
b b
b a
CODE:
For x = erste_spalte To letzte_spalte
'Schleife über jedes Element im der Spalte(vom Erstem bis zum Voreltzten)
For y = erstesy To letztesy - 1
'Schleife über jedes folgende Element in der Spalte
For y2 = y + 1 To letztesy
'Untersuchen ob Elemente gleich sind
If tbl.Cells(y, x) = tbl.cells(y2, x) Then
'nur wenn scharf, soll Verschoben werden (Damit nicht Verschoben wird, wenn lauter gleiche Daten)
If scharf = True Then
'Abstand zwischen den zu betrachteten Elementen berechnen
abstand = y2 - y
'auswählen des momentan betrachteten Elementes
form_agregar.lb_ausw.ListIndex = y - 3
'Verschieben des momentan betrachteten Elementes bis es über dem gleichen Element steht
Do While abstand > 1
'Externe Funktion, welche Elemente tauscht
Call move_down
abstand = abstand - 1
Loop
' nach Verschieben nicht next sondern gleiche Poistion noch einmal
y = y - 1
scharf = False
Exit For
End If
Else
'Wenn keine gleichen Komponenten ->scharf stellen
scharf = True
End If
End If
Next y2
Next y
Next
|