Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1272to1276
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Text zerlegen

Text zerlegen
Alfonso
Hallo VBA-Profis,
ich benötige mal wieder Eure Hilfe:
Ich habe in einer Textspalte verschiedene Einträge (mindestens 250 Zeilen), mal sind sie korrekt - oft nicht.
Alle Einträge einzeln zu korrigieren, ist sehr mühsam. Deshalb suche ich eine VBA-Lösung.
Die vorkommenden Begriffe sollen immer per Komma und Leerstelle getrennt werden (Ausnahme: "Kühl OTC" oder "OTC Kühl" sollen nicht durch Komma getrennt werden und groß/klein-Schreibung spielt keine Rolle).
Die Korrekturen sollen in den Originalzellen durchgeführt werden.
Anbei eine Beispieldatei. Für eine Lösung wäre ich sehr dankbar.
Mfg
Alfonso
https://www.herber.de/bbs/user/81170.xls

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Text zerlegen - Nachfrage
26.07.2012 14:28:01
MatthiasG
Hallo Alfonso,
also ein Komma steht immer als Trennzeichen drin? Der Fehler sind nur fehlende oder zu viele Leerzeichen?
Gruß Matthias
AW: Text zerlegen - Nachfrage
26.07.2012 14:40:24
Alfonso
Hallo Matthias,
es gibt auch Fälle wo kein Komma drin steht. In der Beispieldatei war jetzt zufällig so ein Fall nicht dabei.
Danke für Deine Mühe.
Gruß
Alfonso
AW: Text zerlegen - Nachfrage
26.07.2012 15:17:53
MatthiasG
Hallo Alfonso,
im Prinzip funktioniert das so:

Sub Ersetze()
Const Spalte = 1
Const TrennZ = "|" ' ein Zeichen, dass nicht im Text vorkommten darf!
Dim z As Long, i As Long
Dim tmp As String, org As String
z = Cells(Rows.Count, Spalte).End(xlUp).Row
If z = 1 And Cells(Rows.Count, Spalte)  "" Then z = Rows.Count
For i = 2 To z
tmp = Trim(Cells(i, Spalte))
'alle dreifachen Leerzeichen entfernen:
tmp = Replace(tmp, "   ", "  ", , , vbTextCompare)
'alle doppelten Leerzeichen entfernen:
tmp = Replace(tmp, "  ", " ", , , vbTextCompare)
'Ausnahme: Leerzeichen vorübergehend entfernen:
tmp = Replace(tmp, "Kühl OTC", "KühlOTC", , , vbTextCompare)
tmp = Replace(tmp, "OTC Kühl", "OTCKühl", , , vbTextCompare)
'Komma+Leer durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ", ", TrennZ, , , vbTextCompare)
'Komma durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ",", TrennZ, , , vbTextCompare)
'Leerzeichen durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, " ", TrennZ, , , vbTextCompare)
'spezielles Trennzeichen wieder durch Kooma+Leer ersetzen:
tmp = Replace(tmp, TrennZ, ", ", , , vbTextCompare)
'Ausnahme wieder rückgängig machen:
tmp = Replace(tmp, "KühlOTC", "Kühl OTC", , , vbTextCompare)
tmp = Replace(tmp, "OTCKühl", "OTC Kühl", , , vbTextCompare)
'Dann vielleicht noch einige Groß-Klein-Korrekturen:
tmp = Replace("BTM", "BTM", "BtM", , , vbTextCompare)
tmp = Replace("OTC", "OTC", "OTC", , , vbTextCompare)
'Wert zurückschreiben
Cells(i, 3) = tmp 'Wenn alles passt, ändern in : Cells(i, Spalte) = tmp
Next i
End Sub

Du kannst den Code jetzt nach deinen Vorgaben ergänzen oder korrigieren. Im Beispiel wird z.B. "OTC, Kühl" nicht durch "OTC Kühl" ersetzt. Ich weiß ja nicht, was sachlich richtig ist.
Aber ich hoffe, du hast das Prinzip verstanden.
Am Ende wird der neue Text testhalber in Spalte 3 geschrieben, das bitte ändern wenn es funktioniert.
Gruß Matthias
Anzeige
AW: Text zerlegen - Nachfrage
26.07.2012 15:44:09
UweD
Hallo Mathias hallo Alfonso
Im unteren Bereich ist dir scheinbar ein kleiner Fehler unterlaufen (bei Gross/klein)
Ich hab das mal abgeändert und alle möglichen gemischten Schreibweisen GroSs /klEIn damit erschlagen
Außerdem weiter oben noch das Komme ganz am Ende eleminiert:
Sub Ersetze()
Const Spalte = 1
Const TrennZ = "|" ' ein Zeichen, dass nicht im Text vorkommten darf!
Dim z As Long, i As Long
Dim tmp As String, org As String
z = Cells(Rows.Count, Spalte).End(xlUp).Row
If z = 1 And Cells(Rows.Count, Spalte)  "" Then z = Rows.Count
For i = 2 To z
tmp = Trim(Cells(i, Spalte))
'alle dreifachen Leerzeichen entfernen:
tmp = Replace(tmp, "   ", "  ", , , vbTextCompare)
'alle doppelten Leerzeichen entfernen:
tmp = Replace(tmp, "  ", " ", , , vbTextCompare)
'Komma am Ende noch weg:
If Right(tmp, 1) = "," Then tmp = Left(tmp, Len(tmp) - 1)
'Ausnahme: Leerzeichen vorübergehend entfernen:
tmp = Replace(tmp, "Kühl OTC", "KühlOTC", , , vbTextCompare)
tmp = Replace(tmp, "OTC Kühl", "OTCKühl", , , vbTextCompare)
'Komma+Leer durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ", ", TrennZ, , , vbTextCompare)
'Komma durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ",", TrennZ, , , vbTextCompare)
'Leerzeichen durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, " ", TrennZ, , , vbTextCompare)
'spezielles Trennzeichen wieder durch Kooma+Leer ersetzen:
tmp = Replace(tmp, TrennZ, ", ", , , vbTextCompare)
'Ausnahme wieder rückgängig machen:
tmp = Replace(tmp, "KühlOTC", "Kühl OTC", , , vbTextCompare)
tmp = Replace(tmp, "OTCKühl", "OTC Kühl", , , vbTextCompare)
'Komma am Ende noch weg:
If Right(tmp, Len(tmp)) = "," Then tmp = Left(tmp, Len(tmp) - 1)
'Dann vielleicht noch einige Groß-Klein-Korrekturen:
tmp = Replace(tmp, LCase("BTM"), UCase("BTM"), , , vbTextCompare)
tmp = Replace(tmp, LCase("OTC"), UCase("OTC"), , , vbTextCompare)
'Wert zurückschreiben
Cells(i, 3) = tmp 'Wenn alles passt, ändern in : Cells(i, Spalte) = tmp
Next i
End Sub
Gruß UweD
Anzeige
AW: Text zerlegen - Nachfrage
26.07.2012 15:52:25
MatthiasG
Hallo Uwe,
stimmt die zwei Zeilen hab ich vermasselt ;-)
aber es genügt folgendes:

tmp = Replace(tmp, "BTM", "BtM", , , vbTextCompare)
tmp = Replace(tmp, "OTC", "OTC", , , vbTextCompare)

Denn mit der Option vbTextCompare wird die Groß/Kleinschreibung nicht berücksichtigt, und es heißt ja BtM (Betäubungsmittel).
Danke und Gruß
Matthias
AW: Text zerlegen - Nachfrage
26.07.2012 15:54:55
Alfonso
Hallo Matthias,
hallo Uwe,
vielen Dank für Eure Mühe.
Jetzt mit der letzten Version von Uwe funktioniert es einwandfrei.
Die Lösungen sind SUPER!
Wo lernt man so etwas, ich habe schon 2 Bücher über VBA gelesen und studiert, aber so etwas lernt man dabei nicht?
Gruß Alfonso
Anzeige
AW: Text zerlegen - Nachfrage
26.07.2012 15:58:08
MatthiasG
Hallo Alfonso,
du kannst sowas lernen, indem du hier mitliest und hier Fragen stellst :-)
Viele Grüße
Matthias
AW: Text zerlegen - Nachfrage
26.07.2012 15:56:40
MatthiasG
Hallo Uwe,
und das mit dem Komma am Ende müsste so lauten (denn vorher werden die Kommas ja durch "Komma+Leerzeichen" ersetzt):

'Komma am Ende noch weg:
If Right(tmp, 2) = ", " Then tmp = Left(tmp, Len(tmp) - 2)

Gruß Matthias
AW: Text zerlegen - Nachfrage
26.07.2012 16:05:12
UweD
ich nochmal
- Danke für den Tipp mit "vbTextCompare"
- - -
- an der Stelle wo ich es im Makro eingebaut hatte, ist der Tausch noch nicht erfolgt.
Deshalb reichte die 1
'Komma am Ende noch weg:
If Right(tmp, 1) = "," Then tmp = Left(tmp, Len(tmp) - 1)
:-)
Gruß UweD
Anzeige
AW: Text zerlegen
26.07.2012 16:15:58
MatthiasG
Hallo Uwe,
schau nochmal in dein Posting. Der Code steht nach dem Ersetzen des "|" durch ", ".
und dann hattest du auch einen Fehler, weil

If Right(tmp, Len(tmp)) = "," ...

das kann nur wahr sein wenn tmp = "," ist.
Für Alfonso und alle anderen nochmal der komplette Code (jetzt hoffentlich ohne Fehler):

Sub Ersetze()
Const Spalte = 1
Const TrennZ = "|" ' ein Zeichen, dass nicht im Text vorkommen darf!
Dim z As Long, i As Long
Dim tmp As String, org As String
z = Cells(Rows.Count, Spalte).End(xlUp).Row
If z = 1 And Cells(Rows.Count, Spalte)  "" Then z = Rows.Count
For i = 2 To z
tmp = Trim(Cells(i, Spalte))
'alle dreifachen Leerzeichen entfernen:
tmp = Replace(tmp, "   ", "  ", , , vbTextCompare)
'alle doppelten Leerzeichen entfernen:
tmp = Replace(tmp, "  ", " ", , , vbTextCompare)
'Ausnahme: Leerzeichen vorübergehend entfernen:
tmp = Replace(tmp, "Kühl OTC", "KühlOTC", , , vbTextCompare)
tmp = Replace(tmp, "OTC Kühl", "OTCKühl", , , vbTextCompare)
'Komma+Leer durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ", ", TrennZ, , , vbTextCompare)
'Komma durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, ",", TrennZ, , , vbTextCompare)
'Leerzeichen durch spezielles Trennzeichen ersetzen:
tmp = Replace(tmp, " ", TrennZ, , , vbTextCompare)
'spezielles Trennzeichen wieder durch Kooma+Leer ersetzen:
tmp = Replace(tmp, TrennZ, ", ", , , vbTextCompare)
'Ausnahme wieder rückgängig machen:
tmp = Replace(tmp, "KühlOTC", "Kühl OTC", , , vbTextCompare)
tmp = Replace(tmp, "OTCKühl", "OTC Kühl", , , vbTextCompare)
'Komma am Ende noch weg:
If Right(tmp, 2) = ", " Then tmp = Left(tmp, Len(tmp) - 2)
'Dann vielleicht noch einige Groß-Klein-Korrekturen:
tmp = Replace(tmp, "BTM", "BtM", , , vbTextCompare)
tmp = Replace(tmp, "OTC", "OTC", , , vbTextCompare)
'Wert zurückschreiben
Cells(i, Spalte) = tmp
Next i
End Sub
Grüße,
Matthias
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige