unterschiedliche Anzahl Spalten (mit festen Werten) verketten

[PeterN]

Hola los Todos!

Ich habe eine Liste mit mehreren tausend Zeilen.

In den Zeilen sind 1-x Spalten zusammenhängend gefüllt, also mal A1-G1, mal A2-I2, mal A3-Z3 usw. maximal 50 Spalten, aber immer unterschiedliche Anzahl von Spalten.

Ich würde die Werte in den Spalten gerne mit den festen Werten < p > davor UND < /p > dahinter verketten.

Beispiel:

A1-E1 = WERTA1 WERTB1 WERTC1 WERTD1 WERTE1

Verkettet sähe das dann so aus:

Code:

<p>WERTA1</p><p>WERTB1</p><p>WERTC1</p><p>WERTD1</p><p>WERTE1</p>

Wenn die Anzahl der Spalten gleich wäre, kein Problem, aber mit immer wieder unterschiedlicher Anzahl von Spalten habe ich keine Lösung.

Danke und Gruss

Peter

[chris-ka]

Hi,

dann kannst du Dir das Daten verschieben auch sparen ;)

Verwende die Function MachMirEinP
ist auf Tabelle2 
Dann die Daten kopieren und als Test einfügen wie in Tabelle3


  demoP.xlsm (Größe: 22,69 KB / Downloads: 6)

[Ego]

Hallo Peter,

zu

... aber immer unterschiedliche Anzahl von Spalten.

Dafür gibt es in neueren Excel-Versionen die Funktion Textverketten.

Falls die Funktion in deiner Version noch nicht existiert kannst du die unten stehende UDF Textverkitten nutzen. Dann brauchst du bei einem Versionswechsel nur in den Formeln einen Buchstaben ersetzen und die UDF löschen.

Code:

Function Textverkitten(ByVal Trenn As String, ByVal Leer As Boolean, ParamArray Arr())
Dim R As Range
Dim Z As Long
Dim S As Long
Dim P As Long
Textverkitten = ""
For P = 0 To UBound(Arr)
    If TypeName(Arr(P)) = "Range" Then
        For Each R In Arr(P)
            If R <> "" Or Not Leer Then
                Textverkitten = Textverkitten & Trenn & R
            End If
        Next R
    ElseIf IsArray(Arr(P)) Then
        For Z = 1 To UBound(Arr(P), 1)
            For S = 1 To UBound(Arr(P), 2)
                If Arr(P)(Z, S) <> "" Or Not Leer Then
                    Textverkitten = Textverkitten & Trenn & Arr(P)(Z, S)
                End If
            Next S
        Next Z
    Else
        If Arr(P) <> "" Or Not Leer Then
            Textverkitten = Textverkitten & Trenn & Arr(P)
        End If
    End If
Next P
If Len(Textverkitten) >= Len(Trenn) Then
    Textverkitten = Right(Textverkitten, Len(Textverkitten) - Len(Trenn))
Else
    Textverkitten = ""
End If
End Function

[PeterN]

Super! Klasse!

Vielen lieben Dank Ihr beiden!

Gruss

Peter