Festgeklemmte Satzzeichen

[Quantum]

Hallo liebes Forum,

ich benutze sehr häufig OCR Programme mit denen ich das Ergebnis dann in Excel abspeichere. Bei der Texterkennung kann es dann zu den verschiedensten Fehlern kommen.
Einer davon ist folgender:    "Ist die ein kleiner Testsatz?Ja, es das ist er!"  Wie ihr seht ist das Fragezeichen zwischen 2 Buchstaben eingeklemmt.
Richtig müßte der Satz also so lauten:  "Ist die ein kleiner Testsatz? Ja, es das ist er!" Um dieses Problem zu beseitigen habe ich ein kleines (funktionsfähiges!) Programm geschrieben:

Code:

Sub Festgesetztes_Satzzeichen()
Dim vbs As String, a As Integer, i As Integer
vbs = "Ist die ein kleiner Testsatz?Ja, es das ist er!"

For a = 65 To 122
For i = 65 To 122
vbs = Replace(vbs, Chr(a) & "?" & Chr(i), Chr(a) & "?" & " " & Chr(i))
vbs = Replace(vbs, Chr(a) & "!" & Chr(i), Chr(a) & "!" & " " & Chr(i))
vbs = Replace(vbs, Chr(a) & "." & Chr(i), Chr(a) & "." & " " & Chr(i))
Next i
Next a

End Sub

Ich beseitige den Fehler also durch Ausprobieren der einzelnen möglichen Buchstabenkombinationen. (Den Übergang von Groß Z und klein a  habe ich aus programmiertechnischen Gründen nicht berücksichtigt)
Da ich dieses Programm nun auf alle Zellen anwenden müßte und ich den Fehler nur durch Ausprobieren beseitige, frage ich mich, ob jemand von euch eine bessere Idee hat.

[Kuwer]

Hallo,

vielleicht einfach mit Suchen und Ersetzen:

Code:

Sub Makro1()
 Cells.Replace What:="~?", Replacement:="? ", LookAt:=xlPart, SearchOrder _
     :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 Cells.Replace What:="!", Replacement:="! ", LookAt:=xlPart, SearchOrder _
     :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 Cells.Replace What:=".", Replacement:=". ", LookAt:=xlPart, SearchOrder _
     :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 Cells.Replace What:="  ", Replacement:=" ", LookAt:=xlPart, SearchOrder _
     :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
 Cells.Trim
End Sub

Gruß Uwe

[chris-ka]

HI,

frage ich mich, ob jemand von euch eine bessere Idee hat.

wie wäre es mit einer Rechtschreibprüfung? ;)

Texte wie:;

Das ist ein Text der nicht richtig dargestellt wird.Um zu vermeiden das Sonderzeichen falsch dargestellt werden!Aber geht das so einfach,klar wenn man das richtige Makro schreiben könnte!  . Nur sollte z.B bei einem Datum wie 12.06.2008 nicht nach den Punkten geteilt werden!Das ist doch klar,mal schauen.Auch "z.B" sollte doch nicht getrennt werden,vermute ich mal .  Sowie eine Mailadresse wie Name.Name@xxx.de wären wohl Ausnahmen,sicherlich gibt es noch viel mehr Ausnahmen.:)

[Quantum]

@Uwe

Hallo Uwe,
danke für deinen Lösungsvorschlag. Das Entscheidende dabei ist letztendlich der Einsatz der Trim Funktion.
Mal abgesehen davon, dass ich nicht drauf gekommen bin, der Befehl  Cells.Trim funktioniert bei mir
nicht. Es kommt nur die Medlung Methode oder Eigenschaft wird nicht unterstützt. Muss ich
jetzt eine Feldfunktion schreiben, die alle Zellen aufnimmt und dann jede Zelle einzeln trimmen?

[Stracciatella]

Cells.trim ist schlicht falsch. Zellen können nur einzeln getrimmt werden. Über Felder muß man dies aber auch nicht machen.

Code:

Dim Einzelzelle as Range

For Each Einzelzelle In Range("A1:B100").Cells 'Bereich anpassen!
   With Einzelzelle
       .Value = Trim(.Value)
   End With
Next Einzelzelle

[Quantum]

@Uwe + @Stracicatella: Vielen Dank für eure Hilfe. Damit konnte ich sowohl die durch die OCR  hervorgerufenen Fehler der eingeklemmten Satzendungen, als auch falsche Satzendungen am Ende von einigen  Excel-Zelle erfolgreich korrigieren.

Code:

Sub Fehlerkorrektur_der_OCR()
Dim oneCell As Range

With Range("A:A")
'Eingeklemmte Satzendungen (...Text?Weiter...) wird zu(...Text? Weiter...) :
.Replace "~?", "? ", , , True
.Replace "!", "! ", , , True
.Replace ".", ". ", , , True
'Falsche Satzendung am Zellende (...Text !) wird zu(...Text!):
.Replace " ~?", "? ", , , True
.Replace " !", "! ", , , True
.Replace " .", ". ", , , True
.Replace "  ", " ", , , True
End With

'Trimmen am Satzende / Zellende
For Each oneCell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Cells
oneCell.Value = Trim(oneCell.Value)
Next oneCell

End Sub