Office: Sortieralgorithmus

msz7 · 14. Januar 2017

Guten Morgen zusammen,

ich bin jetzt schon länger dabei an einem Projekt herumzutüfteln. Aber an dieser Stelle komme ich nicht weiter. Folgendes Problem:
Es wird automatisiert eine Excel-Datei erstellt, in der ab B19 Werte (je nach Datei unterschiedlich viele) eingetragen sind. Ab A19 stehen die IDs zu den Werten.

Die Werte werden in zwei Spalten einsortiert. Der Algorithmus dafür soll wiefolgt aussehen:

Bis eben alle Werte sortiert sind. Ich habe das bisher immer mit =KKLEINSTE und =KGRÖSSTE gemacht, aber da ich jetzt auch unterschiedlich viele Werte (pro Datei zwischen 50 und 2.000) bekomme, kriege ich das auf diesem Weg nicht mehr hin.

Ich hänge noch eine Beispieldatei an.

Algorithmus-bsp070616.xlsx

Ich würde mich echt freuen, wenn da jemand einen Lösungsvorschlag parat hat. Ich vermute mit VBA geht es am einfachsten, aber das sind für mich leider böhmische Dörfer *frown.gif*

Liebe Grüße
Marina

:)

aloys78 · 15. Januar 2017

Hallo Marina,

im Anhang mein Vorschlag.

Gruß
Aloys

msz7 · 15. Januar 2017

Hallo Aloys,

vielen Dank für Deinen Vorschlag!

Wenn ich die Datei ausführe, werden die Werte richtig sortiert, aber alle Werte sind doppelt enthalten. Ich glaube das ist, weil der x-größte Wert gleichzeitg auch der x-kleinste Wert ist. Das hatte ich bei meinem Versuch mit KKLEINSTE/KGRÖSSTE auch erst so gemacht *Smilie

Lieben Dank für Deine Hilfe!
Marina

aloys78 · 15. Januar 2017

Hallo Marina,

Ich glaube das ist, weil der x-größte Wert gleichzeitg auch der x-kleinste Wert ist.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Reihenfolge der Kleinsten ist eben die umgekehrte Reihenfolge der Größten.

Das hatte ich bei meinem Versuch mit KKLEINSTE/KGRÖSSTE auch erst so gemacht
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und die Schlußfolgerung ?
Was soll geändert werden ?

Gruß
Aloys

msz7 · 15. Januar 2017

Hallo Aloys,

jede ID darf nur ein einziges mal vorkommen. Wenn ich das richtig sehe, könnte ich die untere Hälfte der sortierten Liste einfach löschen und es wäre richtig *Smilie ich habe gerade auch schon in den Code geguckt, aber da steige ich leider absolut nicht durch und weiß nicht, wie ich das ändern könnte.

Liebe Grüße
Marina

aloys78 · 15. Januar 2017

Hallo Marina,

jede ID darf nur ein einziges mal vorkommen. Wenn ich das richtig sehe, könnte ich die untere Hälfte der sortierten Liste einfach löschen und es wäre richtig
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ok
Wo schneiden wir ab, wenn die Anzahl der Positionen ungerade ist ?
Bei den Kleinsten ?

Gruß
Aloys

msz7 · 15. Januar 2017

Hallo Aloys,

in der Praxis wird das soweit ich weiß niemals vorkommen - aber falls doch, sollte einfach die letzte Zahl bzw. die Zahl mit der höchsten ID übrig bleiben

Lieben dank!
Marina

aloys78 · 15. Januar 2017

Hallo Marina,

ich werde Dir zum Nachmittag eine überarbeitete Lösung zur Verfügung stellen.

Gruß
Aloys

aloys78 · 16. Januar 2017

Hallo Marine,

meine überarbeiteter Code:
Code:

Option Explicit

Private Sub CommandButton1_Click()
' Version V 2.1 vom 16.01.2017
'------------------------------------------------------------------------------
' Umsetzung der Aufgabenstellung
' - die Originaldaten werden in arr gesichert (wenn die Zahl der Zeilen
' ungerade ist, wird die letzte Position (= höchste ID) ignoriert.
' - danach werden sie absteigend nach Wert sortiert und nach arrG
' kopiert; danach werden die Originaldaten wieder hergestellt
' - der Datenstand von n Zeilen wird im Array arrG in seiner 1. Hälfte als
' KGrösste (1 bis n/2) verarbeitet und im Rest als KKleinste (n bis n/2 + 1)
'-------------------------------------------------------------------------------
Dim r As Long ' Zeilen#
Dim LRow As Long, LRow2 As Long ' Nr letzte Zeile
Dim g As Long ' Nr KGrößte
Dim k As Long ' Nr Kkleinste
Dim n As Long ' Anzahl Zeilen
Dim rng As Range ' Bereich Quelldaten
Dim arrG ' Array Reihenfolge der Größten
' Dim arrK ' Array Reihenfolge der Kleinsten
Dim arr ' Array zur Sicherung der Originaldaten
Const sZeile As Long = 19 ' Startzeile

' Vorarbeiten
LRow = Cells(Rows.Count, "A").End(xlUp).Row ' letzte zeile Quellbereich
If LRow < sZeile Then Exit Sub ' es gibt keine Quelldaten
n = LRow - sZeile + 1 ' Anzahl Zeilen im Quellbereich
If n Mod 2 = 1 Then
LRow = LRow - 1 ' wenn n ungerade, dann wird die letzte (höchste) ID "abgeschnitten"
n = n - 1
End If
arr = Range("A" & sZeile & ":B" & LRow) ' Sichere Daten in Array arr
LRow2 = Cells(Rows.Count, "F").End(xlUp).Row ' letzte Zeile Ergebnisbereich
If LRow2 >= sZeile Then Range("F" & sZeile & ":J" & LRow2).ClearContents ' lösche etwa vorhandenes Ergebnis

' sortiere Quelldaten absteigend nach Wert und speichere Ergebnis in arrG
Range("A" & sZeile & ":B" & LRow).Sort Key1:=Range("B" & sZeile), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
arrG = Range("A" & sZeile & ":B" & LRow)

' Original-Quelldaten wieder herstellen
Range("A" & sZeile & ":B" & LRow) = arr

' Ausgangsdaten für Ergebniserstellung
n = n / 2 ' Anzahl Zeilen für je KGrösste und KKleinste
r = sZeile ' Nr erste Quellzeile
g = 1 ' Start-Index größter Wert
k = 2 * n ' Start-Index kleinster Wert

Do
If r Mod 2 = 1 Then
' ungerade Zeile: aufbereiten des Wertes k-kleinste und (k+1)-kleinste
Range("F" & r) = arrG(k, 1)
Range("G" & r) = arrG(k, 2)
Range("I" & r) = arrG(k - 1, 1)
Range("J" & r) = arrG(k - 1, 2)
k = k - 2
Else
' gerade Zeile: aufbereiten des Wertes g-größte und (g+1)-größte
Range("F" & r) = arrG(g, 1)
Range("G" & r) = arrG(g, 2)
Range("I" & r) = arrG(g + 1, 1)
Range("J" & r) = arrG(g + 1, 2)
g = g + 2
End If
r = r + 1
Loop Until r > sZeile + n - 1

' alle Zeilen verarbeitet - lösche Arrays
Erase arr: Erase arrG
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Aloys

msz7 · 16. Januar 2017

Hallo Aloys,

das funktioniert wunderbar! Und vielen Dank, dass Du mir ein bisschen auf die Sprünge hilfst, was genau da eigentlich passiert *Smilie

Damit habe ich Dich erstmal genug belästigt. Lieben Dank und einen schönen Tag wünsche ich Dir noch!
Liebe Grüße
Marina

msz7 · 26. Januar 2017

Hallo Aloys,

ich muss die Datei leider noch etwas erweitern. Die Beispieldatei aus meinem Startbeitrag ist dafür immer noch korrekt.
Die Sortierung soll nicht auf zwei Spalten beschränkt sein, sondern auf bis zu 12 Spalten erweitert werden können. Die Sortiermethode bleibt dabei gleich.

Beispiel mit 4 Spalten:

PHP:

1.-Kleinste 2.-Kleinste 3.-Kleinste 4.-Kleinste 1.-Längste 2.-Längste 3.-Längste 4.-Längste 5.-Kleinste 6.-Kleinste 7.-Kleinste 8.-Kleinste 5.-Längste 6.-Längste 7.-Längste 8.-Längste 9.-Kleinste 10.-Kleinste 11.-Kleinste 12.-Kleinste 9.-Längste 10.-Längste 11.-Längste 12.-Längste usw.

lupo1 · 26. Januar 2017

Hier eine Datei

aloys78 · 26. Januar 2017

Hallo Marina,

auf bis zu 12 Spalten erweitert werden können
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Kann die Spaltenzahl dann jeden Wert von 2 bis 12 annehmen ?
Wie stelltst Du Dir die jeweilige Vorgabe vor ?

Die Sortiermethode bleibt dabei gleich.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bei 2 Spalten hatten wir den letzten Wert abgeschnitten, wenn die Gesamtzahl ungerade war.
Folgerichtig müssten wir dann bei einer Spaltenzahl

msz7 · 26. Januar 2017

Hallo Lupo,

danke für Deinen Tipp! Das werde ich mir auf jeden Fall angucken, aber fürs erste verfolge ich den Vorschlag von Aloys, da ich den ersten Teil dadurch schon wunderbar lösen konnte. Trotzdem danke! *Smilie

Hallo Aloys,

genau, die Spaltenanzahl kann zwischen 2 und 12 variieren. Vielleicht eine kleine Textbox, um die Spaltenanzahl einzugeben?

Genau, falls Werte übergelassen werden, soll der Rest einfach nicht berücksichtigt werden.

Der Name der neuen Excel-Datei sollte sich auf den Text, der in Zelle C1 steht, beziehen und das Datum noch hinten anhängen.

Vielen Dank und liebe Grüße!
Marina

aloys78 · 27. Januar 2017

Hallo Marina,

schau Dir mal die Datei an, das wäre die Grundlage für die Umsetzung.

Gruß
Aloys