Alle Wörter welche mit Kleinbuchstaben beginnen löschen/ersetzen
Uwe Lunkenbein
ich suche ne Möglichkeit alle Wörter die mit Kleinbuchstabe beginnen durch
Komma zu ersetzen. Es sollen nur die Substantive erhalten bleiben.
Habe den Umweg über Word gemacht. Dort geht es mit Mustervergleich
<[a-z]*[a-z]>
Geht Ähnliches mit Excel? Habe zig Tabellen bekommen und möchte mir den
Umweg ersparen.
Gruß und Danke
Uwe
Alexander Wolff
> ich suche ne Möglichkeit alle Wörter die mit Kleinbuchstabe beginnen
> durch Komma zu ersetzen. Es sollen nur die Substantive erhalten
> bleiben.
Die Wörter scheinen bei Dir einzeln untereinander in einer Spalte zu stehen,
da Du dazu nichts sagst. Dann:
=WENN(ODER(ABS(CODE(A1)-{77,5;206,5})<{13;15});A1;",")
mit Strg-Umsch-Eingabe abschließen, sonst FALSCH!
--
Moin+Gruss Alexander - MVP for MS Excel - www.xxcl.de - mso2000sp3 --7-2
Uwe Lunkenbein
> Die Tastatur von Uwe Lunkenbein wurde wie folgt gedrückt:
>> ich suche ne Möglichkeit alle Wörter die mit Kleinbuchstabe beginnen
>> durch Komma zu ersetzen. Es sollen nur die Substantive erhalten
>> bleiben.
>
> Die Wörter scheinen bei Dir einzeln untereinander in einer Spalte zu
> stehen,
> da Du dazu nichts sagst. Dann:
>
> =WENN(ODER(ABS(CODE(A1)-{77,5;206,5})<{13;15});A1;",")
> mit Strg-Umsch-Eingabe abschließen, sonst FALSCH!
Hallo Alexander,
erstmal Danke für die Formel.
Die Wörter stehen nicht untereinander. Eine Zelle enthält z.B.
"medizinische sowie nicht medizinische Diagnostikgeräte, zahnmedizinische
Spatel"
Nur Diagnostikgeräte und Spatel sollen bestehen bleiben
Gruß
Uwe
Alexander Wolff
> Die Wörter scheinen bei Dir einzeln untereinander in einer Spalte zu
> stehen, da Du dazu nichts sagst. Dann:
>
> =WENN(ODER(ABS(CODE(A1)-{77,5;206,5})<{13;15});A1;",")
> mit Strg-Umsch-Eingabe abschließen, sonst FALSCH!
=WENN(CODE(A1)=CODE(GROSS(A1));A1;",")
ist wohl angebrachter ;-) (diesmal normal einzugeben)
Alexander Wolff
Dann nimm =UCaseWordsOnly(A1) mit folgendem Code in einem VBA-Modul:
Function UCaseWordsOnly(S As String) As String
Dim i As Long
Dim n As Long
n = Len(S)
Z = "[A-Z,À-Ý]"
For i = 1 To n
If Mid(S, i, 1) Like Z Then
For k = i To n
If Mid(S, k, 1) = " " Or k = n Then
UCaseWordsOnly = UCaseWordsOnly & Mid(S, i, k - i) & ", "
Exit For
End If
Next
i = k
End If
Next
UCaseWordsOnly = Replace(Replace(UCaseWordsOnly, ",,", ","), ".,", ",")
'. und , im Satz werden gesäubert, ! und ? jedoch nicht.
If Right(UCaseWordsOnly, 2) = ", " Then _
UCaseWordsOnly = Replace(UCaseWordsOnly & ",", ", ,", "")
End Function
Andreas Killer
>> Die Tastatur von Uwe Lunkenbein wurde wie folgt gedrückt:
>>> ich suche ne Möglichkeit alle Wörter die mit Kleinbuchstabe beginnen
>>> durch Komma zu ersetzen. Es sollen nur die Substantive erhalten
>>> bleiben.
...
> Die Wörter stehen nicht untereinander. Eine Zelle enthält z.B.
> "medizinische sowie nicht medizinische Diagnostikgeräte,
> zahnmedizinische Spatel"
> Nur Diagnostikgeräte und Spatel sollen bestehen bleiben
Hmm, Du widersprichst Dir, erst wollest Du alles kleingeschriebene
durch Komma ersetzen, nun sollen sie ganz wegfallen.
Für das nächste mal wäre es nett wenn Du vorher überlegst was genau Du
erreichen möchtest, okay? .-)
Den angehängten Code in ein Modul kopieren und die Sub Main laufen lassen.
Andreas.
Option Compare Binary
Sub Main()
Dim R As Range, I As Long
Dim Zeile As String, Wort As String, Temp As String
'Alle Zellen im benutzten Bereich durchlaufen
For Each R In ActiveSheet.UsedRange
'Zelle einlesen und schon mal die Komma entfernen
Zeile = Replace(R, ",", "")
'Hier ggf. noch mehr ersetzen
Zeile = Replace(Zeile, ".", "")
'Zwischenspeicher leeren
Temp = ""
'Alle Wörter durchlaufen
For I = 1 To strCount(R, " ")
'Ein wort extrahieren
Wort = strParse(I, R, " ", False)
'Ist es groß geschrieben?
If Left(Wort, 1) >= "A" And Left(Wort, 1) <= "Z" Then
'In den Zwischenspeicher
Temp = Temp & Wort & " "
End If
Next
'Zellinhalt ersetzen
R = RTrim(Temp)
Next
End Sub
Function strCount(ByVal S As String, ByVal Delim As String, _
Optional ByVal ConsecutiveDelim As Boolean = False, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare) As _
Long
'Liefert die Anzahl Wörter in S (Delim ist nur ein(!) Trennwort)
Dim Data() As String, I As Long, n As Long
Data = Split(S, Delim, Compare:=Compare)
If ConsecutiveDelim Then
'Aufeinanderfolgende Trennzeichen als ein Zeichen behandeln
n = 0
For I = 0 To UBound(Data)
If Len(Data(I)) > 0 Then n = n + 1
Next
strCount = n
Else
strCount = UBound(Data) + 1
End If
End Function
Function strParse(ByVal n As Long, ByVal S As String, ByVal Delim _
As String, Optional ByVal ConsecutiveDelim As Boolean = False, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare) As _
String
'Liefert das Nte Word in S (Delim ist nur ein(!) Trennwort)
Dim Data() As String, I As Long
If n = 0 Then
strParse = ""
Else
Data = Split(S, Delim, Compare:=Compare)
If ConsecutiveDelim Then
'Aufeinanderfolgende Trennzeichen als ein Zeichen behandeln
If n < 0 Then
'Von hinten
I = UBound(Data)
Do While n < 0 And I >= 0
If Len(Data(I)) > 0 Then n = n + 1
I = I - 1
Loop
If n <> 0 Then strParse = "" Else strParse = Data(I + 1)
Else
'Von vorn
I = 0
Do While n > 0 And I <= UBound(Data)
If Len(Data(I)) > 0 Then n = n - 1
I = I + 1
Loop
If n <> 0 Then strParse = "" Else strParse = Data(I - 1)
End If
Else
If n < 0 Then
If Abs(n) > UBound(Data) + 1 Then strParse = "" Else _
strParse = Data(UBound(Data) + n + 1)
Else
If n > UBound(Data) + 1 Then strParse = "" Else strParse = _
Data(n - 1)
End If
End If
End If
End Function
Uwe Lunkenbein
klappt prima.
Nur den letzten Buchstaben hat es verschluckt.
Habe an: "n = Len(S)" noch +1 angefügt "n = Len(S) + 1"
Gruß
Uwe
Alexander Wolff
> Habe an: "n = Len(S)" noch +1 angefügt "n = Len(S) + 1"
Ei der Daus. Halt schnell und schmutzig :-) Danke fürs Feedback!
Eberhard Funke
> Eine Zelle enthält z.B.
> "medizinische sowie nicht medizinische Diagnostikgeräte, zahnmedizinische
> Spatel"
>
> Nur Diagnostikgeräte und Spatel sollen bestehen bleiben
Noch 'ne Lösung:
Function Subst(Satz As String) As String
Dim varSatz
Dim strSatz As String
Dim intI As Integer
varSatz = Split(Satz, " ")
For intI = 1 To UBound(varSatz)
If Not Left(varSatz(intI), 1) Like "[a-z]" Then
Subst = Subst & " " & varSatz(intI)
End If
Next
End Function
--
Mit freundlichen Grüssen Eberhard
XP home XL 2000
Eberhard(punkt)W(punkt)Funke(at)t-online.de
Michael Schwimmer
Hallo Alexander,
Am Mon, 30 Mar 2009 18:25:43 +0200 schrieb Alexander Wolff:
> Function UCaseWordsOnly(S As String) As String
> Dim i As Long
> Dim n As Long
> n = Len(S)
> Z = "[A-Z,À-Ý]"
> For i = 1 To n
> If Mid(S, i, 1) Like Z Then
> For k = i To n
> If Mid(S, k, 1) = " " Or k = n Then
> UCaseWordsOnly = UCaseWordsOnly & Mid(S, i, k - i) & ", "
> Exit For
> End If
> Next
> i = k
> End If
> Next
> UCaseWordsOnly = Replace(Replace(UCaseWordsOnly, ",,", ","), ".,", ",")
> '. und , im Satz werden gesäubert, ! und ? jedoch nicht.
> If Right(UCaseWordsOnly, 2) = ", " Then _
> UCaseWordsOnly = Replace(UCaseWordsOnly & ",", ", ,", "")
> End Function
hast wohl Option Explicit vergessen ;-)
Die Variablen Z und K sind nicht deklariert.
Viele Grüße
Michael
--
http://michael-schwimmer.de
Masterclass Excel VBA ISBN-10: 3827325250
Das Excel-VBA Codebook ISBN-10: 3827324718
Microsoft Office Excel 2007-Programmierung ISBN-10: 3866454139
Eberhard Funke
um Zeichen wie Komma, Punkt etc. ebenfalls zu entfernen:
> Function Subst(Satz As String) As String
> Dim varSatz
> Dim strSatz As String
> Dim intI As Integer
Dim arrZeichen As Variant
> varSatz = Split(Satz, " ")
> For intI = 1 To UBound(varSatz)
> If Not Left(varSatz(intI), 1) Like "[a-z]" Then
> Subst = Subst & " " & varSatz(intI)
> End If
> Next
arrZeichen = Array(",", ".")
For intI = 1 To UBound(arrZeichen)
Subst = Replace(Subst, arrZeichen(intI), "")
Next
> End Function
Hier im Beispielcode nur Komma und Punkt, Du kannst aber arrZeichen ggf.
erweitern.
Eberhard Funke
Dank an Michael: ich habe vergessen mitzukopieren
Option Explicit
Option Base 1
(Wird dem Code vorangestellt)
Alexander Wolff
>
> Function Subst(Satz As String) As String
> Dim varSatz
> Dim strSatz As String
> Dim intI As Integer
>
> varSatz = Split(Satz, " ")
> For intI = 1 To UBound(varSatz)
> If Not Left(varSatz(intI), 1) Like "[a-z]" Then
> Subst = Subst & " " & varSatz(intI)
> End If
> Next
> End Function
@Michael im anderen Thread: Ja, stimmt. Alte Schlampigkeit.
@Eberhard: Natürlich, Split als Paradedisziplin. Vergesse ich immer wieder.
Schöner kurzer Code!
Eberhard Funke
> Schöner kurzer Code!
Und löscht ausserdem noch das Komma hinter "Diagnostikgeräte" :-(
Alexander Wolff
> Am Mon, 30 Mar 2009 21:25:20 +0200 schrieb Alexander Wolff:
>
>> Schöner kurzer Code!
>
> Und löscht ausserdem noch das Komma hinter "Diagnostikgeräte" :-(
Wundern tu ich mich nur über Dein "wenn nicht [a-z], dann anhängen". Ich
halte die als erlaubt genannten Zeichen "wenn [A-Z,À-Ý]" da als für
sicherer. Was passiert denn bei dir bei den Worten "ähnlich", "@work" und
"östlich"? Oder jedes andere Zeichen, wie etwa Anführungszeichen. Nimm mal
das Beispiel:
- Heinz, wie ist das Leben @work? "fies" und ungerecht -
Wolfgang Habernoll
"Eberhard Funke" <nomail@invalid> schrieb im Newsbeitrag
news:1gg3n7lizo450$.1io7d6ahqqttu.dlg@40tude.net...
bei mir stört sich Split nicht an 'Option Base 0 oder 1' es bleibt ein Datenfeld
ab 0. Besser es mit
For intI = LBound(varSatz) To UBound(varSatz) oder ab 0 durchlaufen.
--
mfG
Wolfgang Habernoll
[ Win XP Home SP-2 , XL2002 ]
Eberhard Funke
> bei mir stört sich Split nicht an 'Option Base 0 oder 1' es bleibt ein Datenfeld
> ab 0. Besser es mit
> For intI = LBound(varSatz) To UBound(varSatz) oder ab 0 durchlaufen.
Hallo Wolfgang,
das hatte ich nachträglich auch bemerkt aber auf ein Korrekturposting
verzichtet, da der OP mit Alexanders Lösung zufrieden war.
Eine weitere Verbesserung hat Alexander an anderer Stelle hier im Thread
vorgeschlagen.
Eberhard Funke
> Wundern tu ich mich nur über Dein "wenn nicht [a-z], dann anhängen".
Das hat mich nachträglich auch gewundert, aber da war's schon raus :-(