Hallo ihr Lieben,
„Heike“ fragte hier vor kurzem nach einer Lösung für ihr „Platzierungs“-Problem (/t/autom-sortierung-von-zellen-mit-text-und-zahl/578…
In einer Antwort davon habe ich bereits eine Excel-seitige Lösung vorgeschlagen, die aber zwei Hilfszeilen benötigt.
Zwischenzeitlich hat es mich in den Fingern gejuckt und ich habe ein Makro dafür geschrieben. Dieses Makro stellt eine ganz „normale“ Excel-Funktion dar und kann auch über das entsprechende Aufrufs-Fenster für Funktionen (unter „benutzerdefiniert“) aufgerufen werden mit
=Platzierung(Matrix;k;Reihe)
Im oberen Bereich des Makros ist hoffentlich ausführlich erklärt was die Matrix, k und die „Reihe“ bedeuten.
Hervorzuheben ist, dass es egal ist ob man einen Spalten- oder Zeilenbereich als Matrix verwendet. Ob man damit auch ganze Zeilen oder Spalten benutzen kann, hab ich jedoch nicht getestet, weil das unwahrscheinlich ist, dass es vorkommt.
Kritiken und Sternchen sind jederzeit gern willkommen 
Viel Spaß beim probieren
Das dazugehörige Makro (welches vielleicht sogar noch verbessert werden kann und ja: „Dim-Anweisungen“ sind nicht so viele vorhanden 
) findet ihr hier:
Function Platzierung(Matrix, k, Reihe)
'Diese Funktion ist dazu geeignet, zusammenhängende Werte zu "Platzieren". Diese Werte müssen sich in einer Reihe befinden.
'Dabei ist es egal, ob diese Reihe eine Spalte oder eine Zeile in Excel ist.
'Den festzulegenden Bereich stellt die Matrix dar. Am Besten eignet sich hier absolute Zellbezüge verwendet werden, da man die
'Formeln dann einfach nur noch "ziehen" muss. Wichtig ist, dass die Matrix nur aus einer Zeile oder Spalte besteht.
'Auch ist unwichtig wie viele Felder diese Matrix beinhaltet. Man kann zb - auch wenn man bisher nur 3 Dinge auswerten möchte (§A§1:blush:C$1) -
'bereits Platz schaffen für 26 ($A$1:blush:Z$1). Er errechnet die Anzahl der Plätze immer aus der vorhandenen Anzahl.
'k stellt die Zahl dar, auf welche Zelle man innerhalb der Matrix selbst zugreift. k ist eine positive Zahl größer 0.
'befindet sich die auszuwertende Zelle direkt über der Ergebniszelle kann man schneller mit "Spalte()" sein Ziel erreichen.
'das gleiche geht natürlich bei "Zeile()" wenn die auszuwertende Zelle sich links davon befindet.
'zur Beachtung: beim "Ziehen" der Formel wird dieser Wert nicht geändert. Mit "Spalte()" und "Zeile()" ist man hier also
'wesentlich flexibler
'Reihe stellt die Zahl dar, wie die Platzierung gewertet wird. Möglich sind hier nur die Werte 0 (ohne Lücke) oder 1 (mit Lücke).
'Dabei geht es darum, wie gezählt wird wenn zwei oder mehr Werte gleich groß sind. Die 1 entspricht also im großen und Ganzen der Funktion "Vergleich()"
'Mit Lücke: 1 2 2 4 5 (hier bleibt eine Lücke zwischen den Doppelwerten und den nachfolgenden Werten)
'Ohne Lücke: 1 2 2 3 4 (fortlaufend weiter platziert)
'(c) 2010 by Tobias König
Dim Feld()
Dim SortFeld()
AnzSp = Matrix.Columns.Count
AnzZe = Matrix.Rows.Count
Suche = IIf(AnzZe = 1, 0, 1) 'Matrix eine Spalte oder eine Zeile?
'Fehlerbehandlung
If AnzSp \> 1 And AnzZe \> 1 Then GoTo Fehler1: 'mehr als eine Zeile / Spalte
If Reihe 1 Then GoTo Fehler2: 'Reihe darf nur 0 oder 1 sein
If Suche = 0 And k \> AnzSp Then GoTo Fehler3:
If Suche = 1 And k \> AnzZe Then GoTo Fehler3:
ZeBeginn = Matrix(1, 1).Row
SpBeginn = Matrix(1, 1).Column
'Begrenzen, wenn Bereich größer ist als tatsächlich Zahlen da sind
If AnzZe = 1 Then
For SpTemp = SpBeginn To SpBeginn + AnzSp
If Cells(ZeBeginn, SpTemp).Value = Empty Then
AnzSp = SpTemp - SpBeginn
Exit For
End If
Next
PrüfWert = Matrix(1, k).Value
Else
For ZeTemp = ZeBeginn To ZeBeginn + AnzZe
If Cells(ZeTemp, SpBeginn).Value = Empty Then
AnzZe = ZeTemp - ZeBeginn
Exit For
End If
Next
PrüfWert = Matrix(k, 1).Value
End If
maxCount = IIf(Suche = 0, AnzSp, AnzZe)
Platz = IIf(Reihe = 0, 1, 0)
ReDim Feld(maxCount - 1)
'Auslesen der einzelnen Werte in ein Feld
For DL = 0 To maxCount - 1
If Suche = 0 Then
SuchSp = DL + SpBeginn
SuchZe = ZeBeginn
Else
SuchZe = DL + ZeBeginn
SuchSp = SpBeginn
End If
Feld(DL) = Cells(SuchZe, SuchSp).Value
Next
'Sortieren der Werte
ReDim SortFeld(maxCount - 1)
Zähler = 0
DL = 0
Do
SuchWert = Feld(DL)
If SuchWert 0 Then
Übertragen = 1
For j = 0 To UBound(Feld)
If SuchWert PrüfTemp And PrüfTemp \> PrüfWert Then
Platz = Platz + 1
PrüfTempAlt = PrüfTemp
Else
Exit For
End If
Next
Else
For i = 0 To UBound(SortFeld)
PrüfTemp = SortFeld(i)
If PrüfWert = PrüfTemp Then
Platz = Platz + 1
Exit For
End If
Next
End If
Platzierung = Platz
Exit Function
Fehler1:
Platzierung = "#Matrix"
Exit Function
Fehler2:
Platzierung = "#Reihe"
Exit Function
Fehler3:
Platzierung = "#k"
End Function
LG
Tobi@s