Text in Zelle per VBA suchen und Zeilenumbruch löschen

Hallo liebes Forum,

ich habe eine Tabelle mit mehreren unterschiedlichen Einzelwerten, welche in den Spalten A, B und C stehen. Diese Einzelwerte (z.B. Farbe, Gewicht, Breite, etc.) werden über eine Suchen & Ersetzen Funktion über "Platzhalter" in eine Zelle in Spalte D, untereinander mit Zeilenumbrüchen geschrieben, sodass eine Zelle die gesamten Werte enthält.
Z.B.
Farbe = blau
Gewicht = 10kg
Breite = 1m

Wobei dann in den Zellen die Werte "blau", "10" und "1" stehen.
Sollte jetzt aus welchen Gründen auch immer ein Einzelwert "leer" sein, möchte ich dass die ganze Zeile verschwindet. Also, z.B. wenn in der Zelle für Gewicht nichts eingetragen ist, soll in der Zelle die Ausgabe dann so aussehen:
Farbe = blau
Breite = 1m

Die Zelle in Spalte D, in die geschrieben wird ist immer mit den jeweiligen Werten vordefiniert, sodass der Code über Ersetzen nach dem Freitext sucht und diesen durch den Wert ersetzt.
Beispiel:
Farbe = varFarbe
Gewicht = varGewicht kg
Breite = varBreite m

Bis jetzt habe ich folgenden Code:





Sub Text_ersetzen()

Dim val_Farbe, val_Gewicht, val_Breite as String

Dim head_Farbe, head_Gewicht, head_Breite, head_Eig As String

Dim col_Farbe, col_Gewicht, col_Breite, col_Eig As Integer

Dim i, last_row, head_row, first_row, loop_row, cl, repl_cl As Long



'Überschriften finden, Spalten rausschreiben und letzte Zeile finden



head_Farbe = "Farbe"

head_Gewicht = "Gewicht"

head_Breite = "Breite"

head_Eig = "Eigenschaften"

head_row = 1



col_Farbe = Application.WorksheetFunction.Match(head_Farbe, Cells(head_row, 1).EntireRow, False)

col_Gewicht = Application.WorksheetFunction.Match(head_Gewicht, Cells(head_row, 1).EntireRow, False)

col_Breite = Application.WorksheetFunction.Match(head_Breite, Cells(head_row, 1).EntireRow, False)

col_Eig = Application.WorksheetFunction.Match(head_Eig, Cells(head_row, 1).EntireRow, False)



last_row = Cells(Rows.Count, col_Eig).End(xlUp).Row



'Schleife zum Austauschen der Variablen

loop_row = 2





For i = loop_row To last_row



'Werte aus den Zellen auslesen

        val_Farbe = Cells(loop_row, col_Farbe).Value

        val_Gewicht = Cells(loop_row, col_Gewicht).Value

        val_Breite = Cells(loop_row, col_Breite).Value



'Werte ersetzen:

        Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "varFarbe", val_Farbe)

        Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "varGewicht", val_Gewicht)

        Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "varBreite", val_Breite)

        

loop_row = loop_row + 1 'Schleife um 1 hochzählen



        Next i



End Sub

Ich komme jetzt nicht so wirklich weiter bei "Werte ersetzen" und wie ich es schaffe, wenn in einer Zelle nichts steht, dass dann diese Textzeile, inkl. Zeilenumbruch aus meinem Text entfernt wird. Wichtig ist hier auch zu erwähnen, dass nur dieser spezielle Zeilenumbruch entfernt werden soll und nicht alle in der Zelle enthaltenen.

Mein Gedankengang wäre jetzt, das ebenfalls über eine Ersetzen-Funktion zu machen, aber da fehlt mir die Idee wie ich den Cursor in die Zeile bekomme um den Zeilenumbruch zu entfernen:



        If IsEmpty(val_Farbe.Value) Then

                

                Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "Farbe = varFarbe", "")

              

                Else

Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "varFarbe", val_Farbe)            

                

                End If

Danke schon mal für die Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

="Das Produkt hat folgende Eigenschaften:"&ZEICHEN(10)&ZEICHEN(10)& LET(üb;Tabelle1[[#Kopfzeilen];[Farbe _]:[Breite _ m]]; Werte;Tabelle1[@[Farbe _]:[Breite _ m]]; TEXTVERKETTEN(ZEICHEN(10);WAHR;WENN(Werte ="";"";WECHSELN(üb;"_";Werte))))

Sub Test() Dim Z As ListRow Dim Elt Dim Txt As String With Range("Tabelle1").Parent.ListObjects("Tabelle1") For Each Z In .ListRows Txt = "Das Produkt hat folgende Eigenschaften:" & vbLf For Each Elt In Split("Farbe;Gewicht;Breite", ";") With Z.Range(.ListColumns(Elt).Index) If .Value > "" Then Txt = Txt & vbLf & Elt & " = " & .Value End With Next Debug.Print Txt Next End With End Sub

hi
naja, meine Formel mit Textverketten sorgt doch dafür, dass bei nicht angegeben Eigenschaften die ganze Zeile fehlt.
Es ist viel einfacher, diese wegzulassen, wenn man den Text neu aufbaut, als ihn hinterher wieder rauszunehmen.

Und wenn der Vortext sich Zeilenweise ändert, kannst du ja den Vortext weiterhin in die Spalte schreiben und von dort in die Formel übernehmen, also nicht als festen Text in die Formel eingeben, sondern als Zellbezug.

Wie gesagt, das einzige was gegen die Formel spricht, wäre wenn die Eigenschaften in einer anderen Reihenfolge aufgeführt werden müssen, als sie in der Tabelle angeordnet sind und sich diese Anordnung der Spalten nicht einfach ändern lässt.

Gruß Daniel

If val_Farbe > "" then Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, "varFarbe", val_Farbe) else Cells(loop_row, col_Eig).Value = Replace(Cells(loop_row, col_Eig).Value, vbLf & "Farbe = varFarbe", "") end if

Function RegExExtrakt(ByVal Target) As String Dim R If TypeOf Target Is Range Then Target = Target.Cells(1).Value Set R = CreateObject("VBScript.RegExp") R.Pattern = "@[\d\D]+@" On Error Resume Next RegExExtrakt = R.Execute(Target)(0) End Function Function Bezeichnung_umsetzen(Text As String) Dim PseudoParam As String Dim P Dim Erg As String PseudoParam = RegExExtrakt(Text) For Each P In Split(Replace(PseudoParam, "@", ""), "|") P = Parameter_suchenUndAufbauen(P) 'siehe vorigen Code If P > "" Then Erg = Erg & vbLf & P Next Bezeichnung_umsetzen = Replace(Text, PseudoParam, Erg) End Function Sub Test() Debug.Print Bezeichnung_umsetzen("das Produkt hat @Farbe|Breite|Höhe@") End Sub

Beliebteste Forumthreads (12 Monate)

Text in Zelle per VBA suchen und Zeilenumbruch löschen

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text in Zelle per VBA suchen und Zeilenumbruch löschen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread