Sub NamesConvert()
Dim rngCell As Range
For Each rngCell In Range("J16:A" & Range("J16").End(xlDown).Row)
rngCell.Value = StringConvertSpecial(rngCell.Value)
Next rngCell
End Sub
Function StringConvertSpecial(Optional strText)
'Aufruf : Msgbox StringConvertSpecial("Hans meier Und söhne gmbh&Co. kg")
'oder zum Testen : Msgbox StringConvertSpecial => standardText wird ausgegeben
'19.02.2009, NoNet - www.excelei.de (z.Zt. down !)
Dim strSchlagworte, strWoerter, strTeil, strTrennzeichen 'alles als VARIANT, da Array !
Dim intS As Integer, intT As Integer, intZ As Integer
'Wörter, die mit fester Schreibweise geschrieben werden sollen :
strSchlagworte = Array("und", "oder", "etc.", "Co.", "KG", "OHG", "GmbH", _
"MS", "z.B.", "NoNet")
strTrennzeichen = Array(" ", "+", "&", "/", ",") 'mögliche Trennzeichen zwischen den Wörtern
'Standardtext ausgeben, wenn Function ohne Argument aufgerufen wurde :
If IsMissing(strText) Then _
strText = "Z.b. : mustermann und NONEt gmbh&Co. kg" 'Text der konvertiert werden soll
strText = StrConv(strText, vbProperCase) 'Pauschal jedes Wort gross schreiben
For intZ = LBound(strTrennzeichen) To UBound(strTrennzeichen)
strWoerter = Split(strText, strTrennzeichen(intZ)) 'Wörter mit aktuellem Trennzeichen trennen
For intT = LBound(strWoerter) To UBound(strWoerter)
strTeil = Split(strWoerter(intT), " ") 'zusätzlich immer nach Lerzeichen trennen
For intS = LBound(strTeil) To UBound(strTeil)
If IsNumeric(Application.Match(strTeil(intS), strSchlagworte, 0)) Then
strTeil(intS) = strSchlagworte(Application.Match(strTeil(intS), strSchlagworte, 0) - 1)
End If
Next
strWoerter(intT) = Join(strTeil, " ")
Next
strText = Join(strWoerter, strTrennzeichen(intZ)) 'Wörter wieder zu Satz zusammenfügen
Next
StringConvertSpecial = strText
End Function
Ich hoffe, das hilft Dir weiter !
Gruß, NoNet
AW: Schlagwörter definieren - Möglichkeit per UDF
detlef
Hallo NoNet,
genau so was hatte ich mir vorgestellt, besten Dank. Allerdings kann ich damit noch nicht alles abfangen. Bei Doppelnamen z.B. Muster-Muster kommt aufgrund des Leerzeichens in der Funktion Muster-muster raus. Auch das Definieren als Trennzeichen nützt aufgrund des Leerzeichens in der Funktion nichts. Natürlich ist das mit dem Leerzeichen wichtig, weil sonst auch andere Teilstrings umgewandelt würden. Auch wenn ich z.B. einen Titel im Namen habe ohne folgendes Leerzeichen Dr.Muster oder bei Inh.Muster funzt es noch nicht. Wie könnte man das noch in die Funktion einbauen.
VG Detlef
AW: Schlagwörter definieren - Möglichkeit per UDF
NoNet
Hallo Detlev,
habe es eben nochmals ausprobiert, und Du hast Recht : Aufgrund der pauschalen Umwandlung per Strconv werden bereits umgewandelte "Einzelworte" wieder in die standar-schreibweise "zurück-umgewandelt", d.h. "Muster-Muster" wird per strConv als 1 Wort erkannt und daher in "Muster-muster" geändert !
Das betrifft alle Worte - mit Ausnahme derer, die mit dem letzten definierten Trennzeichen getrennt wurde (klaro, denn danach ist die Schleife ja zu Ende ;-).
Den Fehler kann man ganz einfach korrigieren indem man Pauschal das erste Zeichen eines jeden "Wortes" in einen Grossbuchstaben umwandelt. Füge daher direkt hinter For intT = LBound(strWoerter) To UBound(strWoerter) folgende Codezeile ein :
strWoerter(intT) = UCase(Left(strWoerter(intT), 1)) & Mid(strWoerter(intT), 2, Len(strWoerter(intT)) - 1)
Das "-" muss freilich zusätzlich als Trennzeichen definiert werden !
Ich habe das jetzt mit folgendem Test-String ausprobiert ("-" und "." als zusätzliche Trennzeichen definiert !) :
"Gemeinschafts-praxis dr.müller-wohlfaHRT+sÖhne gmbh&co. kg in Berlin/tempelHof - getestet z.b. von nonet"
Ergebnis :
Gemeinschafts-Praxis Dr.Müller-Wohlfahrt+Söhne GmbH&Co. KG In Berlin/Tempelhof - Getestet z.B. Von NoNet
Das kommt dem gewünschten Ergebnis doch schon sehr nahe - oder ;-) ?
Gruß, NoNet
AW: Schlagwörter definieren - Möglichkeit per UDF
Detlef
Hallo NoNet,
super, besten Dank.
Gruß, Detlef
AW: Umwandeln von Grossbuchstaben
Grossbuchstaben
Hallo Detlef,
du musst dir deine Ausnahmen als Array definieren, z. B. so:
Public Sub GrossKlein()
Dim rngCell As Range
Dim aAusnahme As Variant
Dim iIndex As Integer
aAusnahme = Array(" Und", " und", " Ohg", " OHG", " Kg", " KG")
For Each rngCell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
rngCell.Value = StrConv(rngCell.Value, vbProperCase)
For iIndex = LBound(aAusnahme) To (UBound(aAusnahme) - 1) Step 2
rngCell.Value = Replace(rngCell.Value, aAusnahme(iIndex), aAusnahme(iIndex + 1))
Next iIndex
Next rngCell
End Sub
Gruß Peter
Vorsicht mit der Konvertierung !
NoNet
Hallo Peter,
Dein Code konvertiert jedoch alle Wörte, die mit den im Array aufgelisteten Begriffen beginnen, aslo z.B. auch Underdog etc. Je nach enthaltenen Begriffen im ARRAY könnte das falsche Konvertierungen nach sich ziehen!
Vielleicht genügt Detlef ja aber auch diese Version - auch wenn sie nur das Leerzeichen als Trennzeichen berücksichtigt... ;-)
Gruß, NoNet
Hej NoNet,
da hast du sicherlich Recht, es war auch nur als Anwendung für wenige Fälle gedacht.
Man könnte evtl. ja auch auf " Und " - also mit führender + nachfolgender Leerstelle abfragen, bzw. replacen, da und ja eigentlich nur zwischen zwei Begriffen vorkommt.
Gruß Peter
|