Textstring zerlegen (variabel)

[Rumo0815]

Hallo zusammen,
ich möchte aus einem Textstring verschiedene Textteile extrahieren.

In der Spalte A stehen unterschiedliche Texte, in denen Zahlenwerte mit Dezimalpunkt enthalten sind:
A1: AdmPaperExtent [ 2891.34 2040.942  ] def
A2: BlockTrf   [1 0 0 1 76.536 1716.384 ] def
A3: BlockSize    [507.402 175.746 ] def

Aus diesen Texten möchte ich die Zahlen mit Dezimalpunkt herausextrahieren.
Diese in die Zellen B und C eintragen.

Wunschergebnis:

B1: 2891.34
B2: 76.536
B3: 507.402

C1: 2040.942
C2: 1716.384
C3: 175.746

Mit TEIL und FINDEN oder SUCHEN komme ich nicht weiter, weil die Zahlen unterschiedlich lang sind.

Weiss jemand eine Lösung?

Vielen Dank vorab!

[Klaus-Dieter]

Hallo,

wenn du das nicht allzu oft brauchst, wäre es eine Option das mit der Funktion Text in Spalten zu trennen. Spaltentrenner wären (in dieser Reihenfolge) : ] [ Dann kannst du die Spalten mit den jeweils überflüssigen Inhalten einfach löschen.

[Rumo0815]

Hallo Klaus-Dieter,
Mit "Text in Spalten" habe ich auch schon probiert, leider benötige ich das mehr als 4.000 mal pro Jahr. Daher wäre eine entsprechende Formel oder ein Makro sehr hilfreich!
Trotzdem Dankeschön für Deine Zeit!

[Klaus-Dieter]

Hallo,

hier mal ein Lösungsvorschlag mit VBA:

Code:

Sub bereinigen()
   Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
       Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
       :="]", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
   Columns("B:B").Delete Shift:=xlToLeft
   Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
       Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
       :="[", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
   Columns("A:A").Delete Shift:=xlToLeft
   Columns("A:A").EntireColumn.AutoFit
   Range("B1:B" & leZeile).FormulaR1C1 = "=TRIM(RC[-1])"
   Range("B1").AutoFill Destination:=Range("B1:B3")
   
   Range("B1:B3").Copy
   Range("A1:A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
       :=False, Transpose:=False
   Columns("A:A").Application.CutCopyMode = False
   Range("B1:B" & leZeile).Delete Shift:=xlToLeft
   Columns("A:A").EntireColumn.AutoFit
End Sub

Function leZeile() As Long
leZeile = CLng(Range(Range(Cells(1, 1), Cells(Rows.Count, Columns.Count)).Find(What:="*", _
       After:=Range("A" & Rows.Count), LookIn:=xlValues, LookAt:=xlWhole, _
       SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Address).Row)
End Function

[LCohen]

Dein B:C wird hier zu D:E:

B1: =WECHSELN(WECHSELN(WECHSELN(GLÄTTEN(A1);"[";);"]";);ZEICHEN(160);)
C1: {=KKLEINSTE(WENN(ISTZAHL(FINDEN(".";TEIL(WECHSELN($B1;" ";WIEDERHOLEN(" ";99));SPALTE($A1:$Z1)*99-98;99)));SPALTE($A1:$Z1));SPALTE(A1))}
D1:E1: =GLÄTTEN(TEIL(WECHSELN($B1;" ";WIEDERHOLEN(" ";99));(SPALTE(A1)+$C1-1)*99-98;99))

{} ist Dir ein Begriff. Sonst dies befolgen.

[Rumo0815]

Hallo LCohen,
vielen Dank für Deine Lösung.
Funktioniert genau so wie ich es mir vorgestellt habe!

Dankeschön fürs "Gehirnschmalz"