Thema Datum  Von Nutzer Rating
Antwort
18.07.2017 12:45:29 Luke
NotSolved
18.07.2017 13:42:25 Werner
NotSolved
18.07.2017 14:07:11 Gast53315
NotSolved
Blau Verketten2 ( Ohne Komma bei leeren feldern in der Tabelle )
18.07.2017 14:55:12 Werner
Solved
18.07.2017 15:05:33 Lukas
NotSolved

Ansicht des Beitrags:
Von:
Werner
Datum:
18.07.2017 14:55:12
Views:
609
Rating: Antwort:
 Nein
Thema:
Verketten2 ( Ohne Komma bei leeren feldern in der Tabelle )

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
18.07.2017 12:45:29 Luke
NotSolved
18.07.2017 13:42:25 Werner
NotSolved
18.07.2017 14:07:11 Gast53315
NotSolved
Blau Verketten2 ( Ohne Komma bei leeren feldern in der Tabelle )
18.07.2017 14:55:12 Werner
Solved
18.07.2017 15:05:33 Lukas
NotSolved