VBA: Function VERKETTENWENN() mit Sortierung
03.03.2012 01:12:36
NoNet
Hallo Franz,
die Sortierung inder UDF ist eine gute Idee !
Hier die angepasste Variante .
Public Function VerkettenWenn(rngVergleichsmatrix, strVergleichswert, _
rngWerte, lngSort, Optional strTrenner)
'Verkettet Werte aus dem Bereich "rngWerte", wenn Wert aus
'Bereich "rngVergleichsmatrix" dem Inhalt von "strVergleichswert" entspricht
'lngSort : 0=Ohne Sortierung, 1=Aufsteigend sortiert, 2=Absteigend sortiert
'Beispiel-Aufruf im Tabellenblatt : =VERKETTENWENN(A2:A20;"xy";B2:B20;0;" - ")
'29.11.2008, NoNet
'Erweitert (Sortierung) : 03.03.2012, NoNet - www.excelei.de
'Beispiel-Aufruf im Tabellenblatt : =VERKETTENWENN(A2:A20;"x";B2:B20;1;" - ")
Dim rngZelle As Range, strTemp As String, lngI As Long
Dim lngA As Long, varA As Variant
Dim arrW()
ReDim Preserve arrW(0)
If IsMissing(strTrenner) Then strTrenner = ","
strTemp = ""
lngI = 0
For Each rngZelle In rngVergleichsmatrix
lngI = lngI + 1
If rngZelle.Value = strVergleichswert Then
If lngSort = 0 Then
strTemp = strTemp & _
Application.Index(rngWerte, lngI) & strTrenner
Else
arrW(UBound(arrW)) = Application.Index(rngWerte, lngI)
ReDim Preserve arrW(UBound(arrW) + 1)
End If
End If
Next
If UBound(arrW) > LBound(arrW) Then ReDim Preserve arrW(UBound(arrW) - 1)
If lngSort Then
For lngI = LBound(arrW) To UBound(arrW)
For lngA = LBound(arrW) To lngI - 1
If (lngSort = 1 And arrW(lngI) > arrW(lngA)) Or _
(lngSort = 2 And arrW(lngI) "" And lngSort = 0 Then strTemp = Left(strTemp, Len(strTemp) - Len(strTrenner) _
)
VerkettenWenn = strTemp
End Function
Die Sortierung wird über den 4. Parameter der Funktion im Aufruf gesteuert :
=VERKETTENWENN(A2:A20;"x";B2:B20;0;" - ") : KEINE Sortierung, Reihenfolge wie in B2:B20
=VERKETTENWENN(A2:A20;"x";B2:B20;1;" - ") : AUFSTEIGENDE Sortierung, nach Wert in B2:B20
=VERKETTENWENN(A2:A20;"x";B2:B20;2;" - ") : ABSTEIGENDE Sortierung, nach Wert in B2:B20
Gruß, NoNet