AW: Umlaute innerhalb verkettung ausschreiben?
31.10.2003 17:05:22
Hajo_Zi
Hallo Markus
Du kennst Dich ja aus. Hier paar Beispiele aus meinem Archiv
Option Explicit
Option Base 1
Sub Umlaute()
' von ManuelaM
Dim arrUm(7) As String
Dim strUm(7) As String
Dim x%
arrUm(1) = "ä"
arrUm(2) = "ö"
arrUm(3) = "ü"
arrUm(4) = "Ä"
arrUm(5) = "Ö"
arrUm(6) = "Ü"
arrUm(7) = "ß"
strUm(1) = "ae"
strUm(2) = "oe"
strUm(3) = "ue"
strUm(4) = "AE"
strUm(5) = "OE"
strUm(6) = "UE"
strUm(7) = "ss"
For x = 1 To 7
On Error Resume Next
Selection.Replace What:=arrUm(x), _
Replacement:=strUm(x), _
LookAt:=xlPart, _
SearchOrder:=xlByColumns
Next
Erase arrUm
Erase strUm
End Sub
Sub EMail_Adresse()
Dim I As Integer
Dim Wert As String
For I = 1 To Cells(Rows.Count, 2).End(xlUp).Row
Wert = LCase(Left(Cells(I, 1), 1) & Cells(I, 2) & "@jumper.ch")
Wert = Application.Substitute(Wert, "ä", "ae")
Wert = Application.Substitute(Wert, "ö", "oe")
Wert = Application.Substitute(Wert, "ü", "ue")
Wert = Application.Substitute(Wert, "ß", "ss")
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 3), Address:="mailto:" & Wert, TextToDisplay:=Wert
Next I
End Sub
Sub Umlaute2()
Dim I As Integer
Dim Wert As String
For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Wert = Cells(I, 1)
Wert = Application.Substitute(Wert, "ä", "ae")
Wert = Application.Substitute(Wert, "ö", "oe")
Wert = Application.Substitute(Wert, "ü", "ue")
Wert = Application.Substitute(Wert, "ß", "ss")
Cells(I, 2) = Wert
Next I
End Sub
Sub Umlaute3()
With Workbooks("Mappe1.xls").Worksheets("Tabelle1").Range("D1:E100")
On Error Resume Next
.Cells.Replace What:="Ä", Replacement:="Ae", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="ä", Replacement:="ae", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="Ö", Replacement:="Oe", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="ö", Replacement:="oe", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="Ü", Replacement:="Ue", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="ü", Replacement:="ue", LookAt:=xlPart, MatchCase:=True
.Cells.Replace What:="ß", Replacement:="ss", LookAt:=xlPart, MatchCase:=True
On Error GoTo 0
End With
' von Volker Croll
End Sub
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.