Mehrere Zellen in einer Zeile nach benutzerdefinierter Liste sortieren

[asdler]

Hallo,
ich möchte mehrere Zellen mit Text in einer Zeile nach einer Vorgabe sortieren, die in einer Liste steht. Da ich die Sortierung für mehr als 4000 Zeilen machen muss, möchte ich gerne eine Funktion nutzen und nicht über das Dialogfeld "Sortieren" arbeiten. Die Sortierreihenfolge ist wie im Beispiel nicht alphabetisch.


  Beispiel2.xlsx (Größe: 9,15 KB / Downloads: 10)

Vielen Dank!

[shift-del]

Moin

Arbeitsblatt mit dem Namen 'Tabelle2'
	A	B	C	D	E	F	G	H	I	J
1	Anzahl	erste	zweite	dritte	vierte		erste sortiert	zweite sortiert	dritte sortiert	vierte sortiert
2	1	grün	gelb	0	0		grün	gelb	0	0
3	2	blau	blau	gelb	grün		grün	gelb	blau	blau
4	1	gelb	0	0	0		gelb	0	0	0
5	4	rot	blau	gelb	0		gelb	blau	rot	0
6	3	gelb	rot	0	0		gelb	rot	0	0
7	1	grün	0	0	0		grün	0	0	0
8
9
10	grün
11	gelb
12	blau
13	rot
14	0

Zelle	Formel
G2	=INDEX($A$10:$A$14;AGGREGAT(15;6;VERGLEICH($B2:$E2;$A$10:$A$14;0);SPALTEN($G2:G2)))

Verwendete Systemkomponenten: [Windows (32-bit) NT 6.01] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

[Der Steuerfuzzi]

Hallo,

so:

Code:

=WENNFEHLER(INDEX($A$10:$A$14;AGGREGAT(15;6;VERGLEICH($B2:$E2;$A$10:$A$14;0);SPALTE(A1)));"")

Oh, da habe ich vergessen zu aktualisieren. Detlef war schneller. Lasse es aber stehen, da ich den Wennfehler noch drumherum machen würde.

[Klaus-Dieter]

Hallo Asdler,

versuche es mal mit diesem Makro:

Code:

Sub sort()
   Dim lngZeile As Long
   Dim strBer As String
   Application.ScreenUpdating = False
   For lngZeile = 2 To 4000
       strBer = "B" & lngZeile & ":" & "I" & lngZeile
       Tabelle1.sort.SortFields.Clear
       Tabelle1.sort.SortFields.Add Key:=Range(strBer), SortOn:=xlSortOnValues, _
           Order:=xlAscending, CustomOrder:="gr?n, gelb, blau, rot, 0", DataOption:=xlSortNormal
       With ActiveWorkbook.Worksheets("Tabelle1").sort
           .SetRange Range(strBer)
           .Header = xlGuess
           .MatchCase = False
           .Orientation = xlLeftToRight
           .SortMethod = xlPinYin
           .Apply
       End With
   Next lngZeile
   Application.ScreenUpdating = True
End Sub

Hinter CustomOrder müsstest du deine tatsächlichen Sortierbegriffe eintragen.