Betrifft: Umlaute innerhalb verkettung ausschreiben?
von: Markus
Geschrieben am: 31.10.2003 17:01:26
Hallo,
innerhal eine Mappe verkette ich und beschneide ich mehrere Spalten miteinander:
Max Mustermann --> musterm
Thomas Müller --> müllert
Wie bekomme ich das hin, dass die Umlaute gleich ausgeschrieben werden?
Beispiel oben= muellet
Für Hilfe Danke im voraus,
Markus
Betrifft: AW: Umlaute innerhalb verkettung ausschreiben?
von: Hajo_Zi
Geschrieben am: 31.10.2003 17:05:22
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.
Betrifft: AW: Ä -> ae, Ö->oe;ü->ue - ganz ohne VBA
von: FP
Geschrieben am: 31.10.2003 21:23:17
Hallo Markus,
Sub KeineUmlaute()
Dim d As Double
With Selection
For d = 1 To .Cells.Count
With .Cells(d)
If Not .HasFormula Then
.Value = WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute( _
WorksheetFunction.Substitute(.Value, "ü", "ue"), _
"ö", "oe"), "ä", "ae"), "Ü", "Ue"), "Ö", "Oe"), "Ä", "Ae"), "ß", "ss")
End If
End With
Next
End With
End Sub