Office: Redundante (Leer-)Zeichen in String eliminieren

Hallo VBA-Profis,

ich habe folgende Frage : Aus einer ASCII-Datei werden per VBA Textzeilen sequentiell eingelesen, die nun weiterverarbeitet werden sollen.
Leider enthalten viele Zeilen dieser ASCII-Dateien Texte mit mehrfachen Leerzeichen dazwischen (z.B. 2 bis 10 Leerzeichen zwischen den einzelnen Begriffen : "Hier stehen 3 Leerzeichen drin")
Zur weiteren Bearbeitung per VBA muss ich diese redundanten Leerzeichen durch nur EIN Leerzeichen ersetzen : "Hier stehen 3 Leerzeichen drin".

Leider ersetzt die VBA-Funktion REPLACE() nicht alle redundanten Leerezeichen auf einmal, d.h. wenn aus 2 Leerzeichen 1 Leerzeichen resultiert und dahinter ein weiteres Leerzeichen steht, so stehen im Ergebnis wiederum 2 Leerzeichen hintereinander. Die VBA-Funktion TRIM() löscht nur am Anfang und am Ende des Textes die Leerzeichen heraus.

Ich habe mir verschiedene Konstrukte gebastelt, mit denen ich das lösen kann. Alle 4 Varianten liefern zwar das gewünschte Ergebnis, aber es gefällt mir nicht, solche "Krücken" benutzen zu müssen :

VBA-Code:

Sub MehrfacheLeerzeichenErsetzen()     'Aufgabe : Aus einem Text (String) sollen redundante Leerzeichen gelöscht werden ,     'so dass anstelle mehrfacher Leerzeichen nur EIN Leerzeichen verbleibt     '09.09.2008, NoNet     Dim strVorlage As String, strText As String     strVorlage = "Hier stehen   3 Leerzeichen drin"     Dim intT As Integer     'Variante 1 : einfaches Ersetzen durch verschachtelte REPLACE-Routinen     'Nachteil : maximale Anzahl der redundanten Leerzeichen muss bekannt sein     strText = strVorlage     strText = Replace(Replace(strText, "  ", " "), "  ", " ")     MsgBox strText     'Variante 2 : Schleife bis keine 2 Leerzeichen mehr enthalten sind :     strText = strVorlage     While InStr(strText, "  ") > 0         strText = Replace(strText, "  ", " ")     Wend     MsgBox strText     'Variante 3 : Ersetzen Zeichenweise in Schleife     strText = strVorlage     For intT = 1 To Len(strText) - 1         If Mid(strText, intT, 2) = "  " Then             strText = Left(strText, intT - 1) & Mid(strText, intT + 1)             intT = intT - 1         End If     Next     MsgBox strText     'Variante 4 : Ersetzen per Tabellenfunktion GLÄTTEN()     'Nachteil : funktioniert natürlich nur für redundante LEERZEICHEN, nicht für and ere Zeichen     strText = strVorlage     strText = Application.WorksheetFunction.Trim(strText)     MsgBox strText End Sub

Code eingefügt mit Syntaxhighlighter 4.15

Gibt es eine andere Funktion, mit der man die redundanten Zeichen entfernen kann ?
Hinweis : Ich meine damit keine selbst programmierte UDF, sondern eine "Standard-VBA-Funktion" !
Grundsätzlich sollten damit möglichst auch andere redundante Zeichen entfernt werden können - also nicht nur auf Leerzeichen beschränkt !

Danke für eure Unterstützung, schönen Feierabend noch...

:)

 

Hallo NoNet,

so?

Public Sub test9()
Dim objRegEx As Object
Dim strText As String
strText = "abc xyz +++ 18 35 21"
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Global = True
.IgnoreCase = True
.Pattern = "[ ]+"
strText = objRegEx.Replace(strText, " ")
End With
Debug.Print strText
Set objRegEx = Nothing
End Sub

 

Nachtrag:

um z.B. die drei + aus meinem Beispiel durch eines zu ersetzen, müsstest du das ganze zweimal machen, nur mit einem anderen Pattern und einem anderen Replace-String. Also so: (das + ist ein Methazeichen und muss darum mit eine Escape (/) davor gesucht werden)

Public Sub test9()
Dim objRegEx As Object
Dim strText As String
strText = "abc xyz +++ 18 35 21"
Set objRegEx = CreateObject("VBScript.RegExp")
With objRegEx
.Global = True
.IgnoreCase = True
.Pattern = "[ ]+"
strText = objRegEx.Replace(strText, " ")
.Pattern = "[/+]+"
strText = objRegEx.Replace(strText, "+")
End With
Debug.Print strText
Set objRegEx = Nothing
End Sub

Ich hatte im Beispieltext viel mehr Leerzeichen drin, die werden aber irgendwie rausgelöscht.

 

Hallo Nepumuk,

vielen Dank für Deinen Lösungsvorschlag. Ich sehe das allerdings eher als Beispiel für "Regular Expression" denn als eine praktikable Lösung für mein Anliegen *wink.gif* Dein Beispiel verfolgt zwar eine gänzlich unterschiedliche Methode zu meinen Varianten, aber lösungstechnisch ist es ebenso eine Krücke (und das meine ich garantiert nicht negativ !) wie meine Lösungsbeispiele, die wie beschrieben ebenfalls alle zum gewünschten Ergebnis führen.

Ich hatte jedoch eine "einfach" anzuwendende VBA-Standardfunktion (ohne UDF !) gesucht, die das löst - in etwa diese (nicht existierende) Funktion =ReplaceMulti(What:=strText, SearchMulti:=" ", ReplaceBySingle:=" ") - aber man darf ja schließlich auch noch träumen *cool.gif*

 

Hallo NoNet,

jetzt mal ehrlich, du hast keine Probleme damit Funktionen aus irgendwelchen DLL's zu benutzen so lange du es nicht siehst. Wenn du Excel öffnest wird z.B. grundsätzlich die MSOx.DLL geladen. Diese lädt automatisch 5 andere DLL's die wiederum auf weitere DLL's zurückgreifen. (siehe Bild)

Aber wenn eine Windows-DLL benutzt wird, huuuch neeee das ist doch kein Excel. Das die 9 DLL's die durch die MSO aufgerufen werden auch reine Windows - DLL's sind wird dabei geflissentlich übersehen.

Das ist ja wie der Selbstbetrug der Formelfreaks mit WF als Vorreiter. Wir machen alles ohne Programm (VBA). Dass aber hinter jeder Excelfunktion ein Programm steht wird weggeblendet. Die glauben immer noch, da sitzt ein kleiner Japaner mit einem Abakus irgendwo im Computergehäuse der das ganze per Hand berechnet. *tongue.gif*

Also, was soll das???? *rolleyes.gif*