Hallo,
hier aus dem Herber-Forum die benutzerdefinierte Funktion VJoin von Luc
Option Explicit
Public Enum cxTriState: cxAsUsed = -2: cxRTrue: cxFalse: cxPTrue: End Enum
Rem Verbinden aller Elemente 1es belieb Vektors
' (Arg3 fehlt/0) bzw 1er Matrix (Arg3>0/<=-1)
' Arg1: ZBereich or DatenFeld (aus Ausdruck);
' Arg2: BindeTxt - fehlt LeerZchn, leer ohne,
' Fwert lokListTrenn; Arg3: fehlt/0/<-1 alle,
' ±1 ohne leere u.Wdholgg, -1 ganze Elemente,
' -2 alle ganzen ohne leere, >0 auch Element-
' Teile, abhängig v.ihrer AuftrittsReihfolge.
' Achtung! Benötigt Enum[eration] cxTriState!
' Vs1.4 -LSr -cd:20130904 -1pub:20130905herber -lupd:20150716n
Function VJoin(Bezug, Optional ByVal BindeZ, Optional ByVal NurUngl As cxTriState)
Dim lix As Long, pix As Long, erg, xBez As Variant
On Error Resume Next: NurUngl = Sgn(NurUngl) + CInt(NurUngl < cxRTrue)
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
erg = Bezug
ElseIf CBool(NurUngl) Then
If NurUngl = cxRTrue Then ReDim erg(0)
For Each xBez In Bezug
If NurUngl = cxRTrue Then
If CBool(lix) And xBez <> "" Then
pix = 0: pix = .Match(xBez, erg, 0)
If pix = 0 Then ReDim Preserve erg(lix): _
erg(lix) = xBez: lix = lix + 1
ElseIf xBez <> "" Then
erg(0) = xBez: lix = lix + 1
End If
ElseIf Not IsEmpty(erg) Then
If NurUngl = cxAsUsed Or (xBez <> "" And _
InStr(erg, xBez) = 0) Then erg = erg & BindeZ & xBez
ElseIf xBez <> "" Then
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 = cxRTrue Then VJoin = Join(erg, BindeZ) Else VJoin = erg
End Function
Der Aufruf für deinen Fall:=VJoin(A1:A30;",";-1)
Gruß Werner
|