Alles außerhalb eines bestimmten Textes löschen

Question

Hallo,

könnt ihr mir bei folgender Problemstellung helfen?

Ich habe einen Text in einer Zelle, der z.B. so aussieht:

<ut Style="external" DisplayText="ps">&lt;ps &quot;TAB-CellHead&quot; 13&gt;</ut><Tu Origin="manual" MatchPercent="0"><Tuv Lang="DE-DE">Schutzausrüstung ABC</Tuv><Tuv Lang="NL-NL">Veiligheidsuitrusting ABC</Tuv></Tu>.

Relevant für mich sind nur die Texte:

Schutzausrüstung ABC
Veiligheidsuitrusting ABC

Ich suche nun eine Möglichkeit, wie ich alle anderen Texte löschen kann, damit diese 2 Texte übrigbleibeiben und in 2 verschiedene Zellen geschrieben werden. Untereinander und optional auch nebeneinander.

Habt ihr eine Idee?

Danke!

Answer 1

mark
copy
paste?

Answer 2

Hallo,

vielen Dank, aber ich dachte nicht, dass ich dazu schreiben muss, dass es sich um eine Unzahl von Zellen, und natürlich nicht nur um diese eine handelt ;-)

Answer 3

hi all ^^

ein beispiel
einer benutzerdefinierten variante

gruss nighty :-)

syntax
zelle,position

Function Sumtext(Zellen As Range, zaehler1 As Integer) As String
Dim Zelle As Range
Dim zeich1 As Integer
Dim schalter As Boolean
Dim zaehler0 As Integer
Dim zaehler3 As Integer
ReDim zaehler2(Len([Zellen])) As String
zaehler3 = 1
Application.Volatile
If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
For zeich1 = 1 To Len([Zellen])
If Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = True Then
zaehler2(zaehler3) = zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
schalter = True
If zaehler2(zaehler3) = "ABC" Then
zaehler0 = zaehler0 + 1
If zaehler0 = zaehler1 Then zaehler1 = zaehler3
End If
End If
If schalter = True And Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = False Then
zaehler3 = zaehler3 + 1
schalter = False
End If
Next zeich1
Sumtext = zaehler2(zaehler1 - 1) & " " & zaehler2(zaehler1)
End Function

Answer 4

hi all ^^

noch ein beispiel der syntax

gruss nighty

=Sumtext(A1;1)
Schutzausrüstung ABC

=Sumtext(A1;2)
Veiligheidsuitrusting ABC

die function liesse sich auch in einem macro aufrufen

Answer 5

hi all ^^

oder hier mit makro

spalte a text,spalte b wie c ausgabe

gruss nighty

Sub trennen()
Dim TbZeile As Long
Dim zaehler As Long
TbZeile = Cells(Rows.Count, 1).End(xlUp).Row
ReDim TbSpaA(TbZeile, 3) As Variant
TbSpaA() = Range(Cells(2, 1), Cells(TbZeile, 3))
For zaehler = 1 To TbZeile - 1
TbSpaA(zaehler, 2) = Sumtext(TbSpaA(zaehler, 1), 1)
TbSpaA(zaehler, 3) = Sumtext(TbSpaA(zaehler, 1), 2)
Next zaehler
Range(Cells(2, 1), Cells(TbZeile, 3)) = TbSpaA()
End Sub


Function Sumtext(Zellen As Variant, zaehler1 As Integer) As String
Dim Zelle As Range
Dim zeich1 As Integer
Dim schalter As Boolean
Dim zaehler0 As Integer
Dim zaehler3 As Integer
ReDim zaehler2(Len([Zellen])) As String
zaehler3 = 1
Application.Volatile
If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
For zeich1 = 1 To Len([Zellen])
If Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = True Then
zaehler2(zaehler3) = zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
schalter = True
If zaehler2(zaehler3) = "ABC" Then
zaehler0 = zaehler0 + 1
If zaehler0 = zaehler1 Then zaehler1 = zaehler3
End If
End If
If schalter = True And Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = False Then
zaehler3 = zaehler3 + 1
schalter = False
End If
Next zeich1
Sumtext = zaehler2(zaehler1 - 1) & " " & zaehler2(zaehler1)
End Function

Answer 6

Hi nighty,

vielen Dank, ich probier es gleich mal aus.

Die Texte sind aber immer unterschiedlich, hast du das berücksichtigt? Weil ich irgendwo das "ABC" in der Makro gelesen habe.

Gruß,
Buuu

Answer 7

hi all ^^

das ABC waere der einzige punkt zum ansetzen,sollte sich das aendern dann gibt es keine loesung da der bezug fehlt

oder siehst du andere bezugspunkte ?

dann raus damit

gruss nighty

Answer 8

hi all ^^

oder statt "ABC" nach

"Lang"

womit das anschliessende dritte wort der treffer waere :-)

gruss nighty

Answer 9

hi all ^^

nach "Lang" bezugnehmend

gruss nighty

Sub trennen()
Dim TbZeile As Long
Dim zaehler As Long
TbZeile = Cells(Rows.Count, 1).End(xlUp).Row
ReDim TbSpaA(TbZeile, 3) As Variant
TbSpaA() = Range(Cells(2, 1), Cells(TbZeile, 3))
For zaehler = 1 To TbZeile - 1
TbSpaA(zaehler, 2) = Sumtext(TbSpaA(zaehler, 1), 1)
TbSpaA(zaehler, 3) = Sumtext(TbSpaA(zaehler, 1), 2)
Next zaehler
Range(Cells(2, 1), Cells(TbZeile, 3)) = TbSpaA()
End Sub


Function Sumtext(Zellen As Variant, zaehler1 As Integer) As String
Dim Zelle As Range
Dim zeich1 As Integer
Dim schalter As Boolean
Dim zaehler0 As Integer
Dim zaehler3 As Integer
ReDim zaehler2(Len([Zellen])) As String
zaehler3 = 1
Application.Volatile
If zaehler1 > Len([Zellen]) Then zaehler1 = Len([Zellen])
For zeich1 = 1 To Len([Zellen])
If Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = True Then
zaehler2(zaehler3) = zaehler2(zaehler3) & Mid([Zellen], zeich1, 1)
schalter = True
If zaehler2(zaehler3) = "Lang" Then
zaehler0 = zaehler0 + 1
If zaehler0 = zaehler1 Then zaehler1 = zaehler3
End If
End If
If schalter = True And Mid([Zellen], zeich1, 1) Like "[A-Za-zßÄäÖöÜü]" = False Then
zaehler3 = zaehler3 + 1
schalter = False
End If
Next zeich1
Sumtext = zaehler2(zaehler1 + 3) & " " & zaehler2(zaehler1 + 4)
End Function

Answer 10

Hu nighty,

diese texre außerhalb sind immer gleich.

"><Tuv Lang="DE-DE">Schutzausrüstung ABC</Tuv><Tuv Lang="NL-NL">Veiligheidsuitrusting ABC</Tuv></Tu>.

hilft das weiter?