Guten Tag Zusammen

Es ist meine erstes Mal in einem Forum, ich hoffe ich die Problemstellung von mir ist klar definiert.
Ausgangslage:
Ich arbeite in einem Architekturbüro und wir wollen automatische Auswertungen von Mehrschichtigen Bauteilen erstellen.
Das Bauteil erhält in der CAD Software ein Kurznamen und die Bestandteile werden nachfolgend aufgelistet, gefolgt von einer leeren Zeile.
Da die Liste immer neu generiert wird wenn ich weitere Bauteile hinzufüge und diese je nach Schichtenanzahl variieren, wollte ich das mit VBA lösen, jedoch reichen meine Kenntnis nicht aus.

In Excel (Das Excel habe ich beigelegt, dort einfach mit zwei Tabellenblättern)
A1 = WGA A2 - A4: leer A5 = (Ergebnis) Textkette{B2;B3;", ";C2;C3}
B1 = leer B2 = Gips B3=10mm
C1 = leer C2 = Abrieb C3 = 5mm
D1 = leer D2 = leer C3 = leer

E1 = WMGA E2 - E4: leer E5 = (Ergebnis) Textkette{F2;F3;", ";G2;G3", ";H2;H3}
F1 = leer B2 = Mauerwerk B3=15mm
G1 = leer C2 = Gips C3 = 10mm
H1 = leer D2 = Abrieb C3 = 5mm
I1 = leer I2 = leer I3 = leer

Mein Wunsch wäre es, dass das Ergebnis dynamisch erstellt wird. Sprich wenn in meiner Tabelle das erste Bauteil drei Schichten erhält sich die Textkette anpasst.

Nun zur meiner Frage, ist das möglich und wenn ja, wie ?
Ich danke euch allen schon Vorab für eure Hilfe

Beste Grüsse
Raphael

https://www.herber.de/bbs/user/168975.xlsx

Moin, Raphael!
Das Trennzeichen kannst du noch einstellen, wenn es dir nicht passt. Ergebnis:

-	A	B
1	UG_WA_DM_D02_140	Dämmung, swissporXPS 0,14
2	K_WA_IW_L05_70	Gips 0,03/Gips 0,04
3	HN_WA_IW_HLZ01_20	Holz 0,02
4	HN_DE_DA_HLZ04_19	Dreischichtplatte 550 0,02
5	K_DB_BO_VB02_90	Beton, Hartbeton 300 0,09
6	HN_DE_DA_D06_140	Dämmung, Aussen 0,14
7	UG_DE_GD_M11_250	Beton, Stahlbeton 0,2/Beton, Pref. 0,05
8	UG_DE_GD_M14_350	Beton, Stahlbeton 0,35
9	HN_WA_AW_M08_60	Beton, Stahlbeton 0,06

Sub Bauteil_komponenten()

    

    Dim rng As Range

    Dim Bauteil_z As Range

    Dim i As Long

    Dim sh_2 As Worksheet

    Dim LZ_sh2 As Long

    Dim Trenner As String

    

    Set rng = Range("A3:A" & Rows.Count).SpecialCells(xlCellTypeConstants) 'Zeilen finden

    Set sh_2 = Sheets("Namenskonvention")

    sh_2.Cells.ClearContents 'alles löschen

    LZ_sh2 = 1 'einfügen ab Zeile 1

    Trenner = "/" 'Trennzeichen

    

    For Each Bauteil_z In rng.Rows

        If Cells(Bauteil_z.Row, 1) <> "" Then

            i = 1

            Komponente = ""



            Do

                Komponente = Komponente & IIf(Komponente <> "", Trenner, "") & _

                            Cells(Bauteil_z.Row + i, 2) & " " & Cells(Bauteil_z.Row + i, 3)

                i = i + 1

            Loop While Cells(Bauteil_z.Row + i, 2) <> ""

            

            'Debug.Print Cells(Bauteil_z.Row, 1), Komponente

            

            sh_2.Cells(LZ_sh2, 1) = Cells(Bauteil_z.Row, 1)

            sh_2.Cells(LZ_sh2, 2) = Komponente

            LZ_sh2 = LZ_sh2 + 1 'hochzählen

        End If

    Next Bauteil_z

End Sub

Gruß, MCO

Hi MCO

Vielen Dank dir für die super schnelle Antwort, so funktioniert es wie ich es braucht :)

Gruss, Raphael