Function InStrRev97()
' Datum : 23.09.2003
' EntwicklerIn : Guido Palacios
' Version : Initial
' Kommentar : Erstrealisierung
' Beschreibung : Gibt die Position des von hinten zuerst gefundenen Zeichens in
' einem String zurueck
Public
Function InStrRev97(mystr As Variant, mydelim As String) As Long
' Variablendeklararion
Dim i As Long
Dim j As Long
' Beginn der eigentlichen Prozedur
On Error GoTo msgerror
InStrRev97 = 0
j = Len(mydelim)
For i = Len(mystr) To 1 Step -1
If Mid(mystr, i, j) = mydelim Then
InStrRev97 = i
Exit Function
End If
Next i
' Fehlerbehandlung
msgerror:
MsgBox Err.Number & Chr$(13) & Err.Description
' Ende der eigentlichen Prozedur
End Function
Grüße
Guido P.
Function LastInStr(Text As String, Suchtext As String) As Integer
Dim Pos As Integer, OldPos As Integer
Do
OldPos = Pos
Pos = InStr(Pos + 1, Text, Suchtext)
Loop Until Pos = 0
LastInStr = OldPos
End Function
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
r = Target.Row
s = Target.Column
If Target.Value = "" Then
Exit Sub
Else
strasse = Mid(Target.Value, 1, LastInStr(Target.Value, " ") - 1)
nr = Mid(Target.Value, LastInStr(Target.Value, " ") + 1, 99)
Application.EnableEvents = False
Cells(r, s).Value = strasse
Cells(r, s + 1).Value = nr
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim laenge As Long
Dim start As Long
Dim Nr As Long
Dim Strasse As String
If InStr(Target.Value, " ") = 0 Then
Exit Sub
Else
laenge = InStr(Target.Value, " ")
If Target.Column = 2 Then
Strasse = Trim(Left(Target.Value, laenge))
Nr = Mid(Target.Value, laenge + 1)
Cells(Target.Row, 2) = Strasse
Cells(Target.Row, 3) = Nr
End If
End If
End Sub