AW: trotzdem noch offen !
01.02.2008 14:15:18
Chris
Servus Steve,
dann so:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim reihe As Long
Dim i As Integer
Dim zähler As Double
Dim neu As String, neu1 As String
If Target.Cells.Count > 1 Then
Call ausweich
Exit Sub
End If
If Target.Value = "" Then
Exit Sub
End If
If Not Intersect(Target, Range("H:H")) Is Nothing Then
reihe = Target.Row
neu = Target.Value
For i = 1 To Len(neu)
zähler = zähler + 1
If Mid(neu, i, 1) = "/" Then
Exit For
End If
If zähler = Len(neu) Then
Exit Sub
End If
Next i
neu1 = Right(neu, Len(neu) - zähler)
Range("O" & reihe) = neu1
Range("O" & reihe).TextToColumns Destination:=Range("O" & reihe), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("H" & reihe) = Left(neu, zähler - 1)
End If
End Sub
Sub ausweich()
Dim reihe As Long
Dim i As Integer
Dim zähler As Double
Dim neu As String, neu1 As String
reihe = ActiveCell.Row
If Range("H" & reihe) "" Then
neu = Range("H" & reihe)
For i = 1 To Len(neu)
zähler = zähler + 1
If Mid(neu, i, 1) = "/" Then
Exit For
End If
If zähler = Len(neu) Then
Exit Sub
End If
Next i
neu1 = Right(neu, Len(neu) - zähler)
Range("O" & reihe) = neu1
Range("O" & reihe).TextToColumns Destination:=Range("O" & reihe), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("H" & reihe) = Left(neu, zähler - 1)
Else
Exit Sub
End If
End Sub
Das geht aber nur für einzelne Zeilen, bei Blöcken wird nur die erste Zeile des Blocks transformiert. Beide Makros in das gleiche Tabellenblatt (alt+F11, u.s.w.)
Gruß
Chris