Na, gemeint war doch Folgendes, ...
31.01.2015 14:42:51
Luc:-?
…Florian;
in der bisherigen Fml ist der Probleme bereitende VJoin-Teil doch der fett-blau markierte:
@WECHSELN(WECHSELN(F$1;"
";VJoin(WENN(A$2:A$40000=E2;B$2:B$40000;"");"+";1);1);"
";VJoin(WENN(A$2:A$40000=E2;C$2:C$40000;"");"+";1);1)&VJoin(WENN(A$2:A$40000=E2;D$2:D$40000;"");"+";1)
Genau den solltest du austauschen, wobei eine Variante, bei der dem Bereich vorn und hinten LeerZeichen hinzugefügt wdn und dann 3 LeerZeichen gg + ausgetauscht wdn müssen, ggf besser wäre; also dann insgesamt so:
@WECHSELN(WECHSELN(F$1;"
";GLÄTTEN(WECHSELN(VJoin(WENN(A$2:A$40000=E2;" "&
B$2:B$40000&" ";"");;1);" ";"+"));1);"
";VJoin(WENN(A$2:A$40000=E2;C$2:C$40000;
"");"+";1);1)&VJoin(WENN(A$2:A$40000=E2;D$2:D$40000;"");"+";1)
Aber das ist nun nicht mehr nötig, weil ich die Vs1.2 fertig habe, die auch noch wie die Vs1.1 fktioniert, wenn man sie wie bisher argumentiert. Sie benötigt allerdings eine Enumeration, die separat, ganz am Anfang des Moduls angegeben wdn muss. Deshalb zeige ich hier mal den ganzen ModulAnfang:
Option Explicit
Public Enum xlTriState: xlTrue = -1: xlFalse: xlCTrue: End Enum
Rem Verbinden aller Elemente 1es belieb Vektors
' Arg1: ZBereich or DatenFeld (aus Ausdruck);
' Arg2: BindeTxt - fehlt LeerZchn, leer ohne,
' Fwert lokal ListTrennZ; Arg3: fehlt/0 alle,
' ±1 ohne leere u.Wdholgg, -1 ganze Elemente,
' +1 auch ElemTeile abhgg v.AuftrittsRhfolge.
' Achtung! Benötigt Enum[eration] xlTriState!
' Vs1.2 -LSr -cd:20130904 -1pub:20130905herber -lupd:20150131t
Function VJoin(Bezug, Optional ByVal BindeZ, Optional ByVal NurUngl As xlTriState)
Dim lix As Long, pix As Long, erg, xBez As Variant
On Error Resume Next: NurUngl = Sgn(NurUngl)
If Not IsMissing(BindeZ) Then
If IsError(BindeZ) Then BindeZ = Application.International(xlListSeparator)
Else: BindeZ = " "
End If
With WorksheetFunction
If TypeName(Bezug) = "Range" Then Bezug = .Transpose(.Transpose(Bezug))
If IsError(LBound(Bezug)) Then
VJoin = Bezug
ElseIf CBool(NurUngl) Then
If NurUngl = xlTrue Then ReDim erg(0)
For Each xBez In Bezug
If NurUngl = xlTrue Then
If CBool(lix) Then
pix = 0: pix = .Match(xBez, erg, 0)
If pix = 0 Then ReDim Preserve erg(lix): _
erg(lix) = xBez: lix = lix + 1
Else: erg(0) = xBez: lix = lix + 1
End If
ElseIf Not IsEmpty(erg) Then
If xBez "" And InStr(erg, xBez) = 0 Then _
erg = erg & BindeZ & xBez
Else: erg = xBez
End If
Next xBez
ElseIf IsError(LBound(Bezug, 2)) Then
erg = Join(Bezug, BindeZ)
Else: Bezug = .Transpose(Bezug)
If IsError(LBound(Bezug, 2)) Then
erg = Join(Bezug, BindeZ)
Else: erg = CVErr(xlErrRef)
End If
End If
End With
If NurUngl = xlTrue Then VJoin = Join(erg, BindeZ) Else VJoin = erg
End Function
Die Fml kann dann auch mit 3.VJoin-Argument=-1 formuliert wdn:
@WECHSELN(WECHSELN(F$1;"
";VJoin(WENN(A$2:A$40000=E2;B$2:B$40000;"");"+";-1);1);"
";VJoin(WENN(A$2:A$40000=E2;C$2:C$40000;"");"+";-1);1)&VJoin(WENN(A$2:A$40000=E2;D$2:D$40000;"");"+";-1)
Die oben gezeigte, korrigierte alte Fml sollte allerdings das gleiche Ergebnis liefern wie diese hier.
Viel Erfolg! Gruß, Luc :-?