AW: Text in Spalten
20.10.2008 14:39:00
Tino
Hallo,
hier mal eine Möglichkeit mit einer Hilfstabelle.
Achtung bisheriger Inhalt wird überschrieben!!
Option Explicit
Sub Trennen()
Dim Bereich As Range
Dim TempSheet As Worksheet
Dim akSheet As Worksheet
Set akSheet = ActiveSheet
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Set Bereich = Range("A1", Cells(Rows.Count, "A").End(xlUp))
Set TempSheet = Sheets.Add
With TempSheet
Bereich.Copy .Range("A1")
Set Bereich = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
Bereich.Offset(0, 1).FormulaR1C1 = _
"=IF(ISERR(LEFT(RC1,FIND("" "",RC1))),RC1,LEFT(RC1,FIND("" "",RC1)))"
Bereich.Offset(0, 1).Value = Bereich.Offset(0, 1).Value
Bereich.Offset(0, 2).FormulaR1C1 = _
"=IF(ISERR(RIGHT(RC1,LEN(RC1)-FIND("" "",RC1))),"""",RIGHT(RC1,LEN(RC1)-FIND("" "",RC1)))"
Bereich.Offset(0, 2).Value = Bereich.Offset(0, 2).Value
Bereich.EntireColumn.Delete
.Columns("A:B").Copy akSheet.Range("A1")
.Delete
End With
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Gruß Tino