Replace bei Buchstaben nur erste 2 Zeichen beachte

Hallo zusammen,
aktuell benutze ich Replace um Zeichenketten zu ersetzten, jetzt habe ich aber folgende Schwierigkeit, die im SuchArray enthaltenen Buchstaben können auch im Text "mittig" enthalten sein und hier sollten sie nicht ersetzt werden.
suchArray = Array(" ", ".", "/", "MB", "MA", "MQ", "MN", "MH", "ZQ", "FQ")
ersetzArray = Array("", "", "", "B", "A", "Q", "N", "H", "Q", "Q")
For i = LBound(suchArray) To UBound(suchArray)
Worksheets(TabellenName).Range(Cells(RowIndex, ColumnIndex), Cells(letzteZeile, ColumnIndex)).Replace What:=suchArray(i), Replacement:=ersetzArray(i), Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Next i
Ich hoffe ein Beispiel macht es anschaulicher:
- Bei Leerzeichen, Punkt und Slash soll die ganze Zeichenkette betrachtet und ersetzt werden, (also alle Leerzeichen, Punkte löschen)
- Bei Buchstaben, soll nur die ersten 2 Zeichen betrachtet und ersetzt werden.
Aus z.B.
"MAMA" soll "AMA" werden und nicht wie mit Code von oben "AA" oder
"MA MU MB/A" soll "AMUMBA" werden
meine versuche mit * und xlWhole schlugen leider fehl.
Vielen Dank
Curly

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Curly
Probier bitte mal diesen Code aus, damit sollte es klappen. Thread danach bitte schliessen. Viel Spass beim testen ...
Die Spalte "A" in Const musst du ggf. für deine Datei von Hand korrigieren.
mfg Piet

Option Explicit
Const Spalte = "A"
Sub Replace_String()
Dim suchArray, rFind As Range, i As Long
suchArray = Array("MB", "MA", "MQ", "MN", "MH", "ZQ", "FQ")
With Worksheets("Tabelle1")
'" ", ".", "/" alles löschen
.Columns(Spalte).Replace " ", ""
.Columns(Spalte).Replace ".", ""
.Columns(Spalte).Replace "/", ""
'Array über Suchlauf auswerten
For i = LBound(suchArray) To UBound(suchArray)
Set rFind = .Columns(Spalte).Find(What:=suchArray(i), After:=Cells(1, Spalte), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
Do  'Prüfe 2 Stellen Links auf Übereinstimmung
If Left(rFind, 2) = suchArray(i) Then
rFind.Value = Mid(rFind, 2, Len(rFind))
End If
Set rFind = .Columns(Spalte).FindNext(After:=rFind)
If rFind Is Nothing Then Exit Do
Loop
End If
Next i
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Replace bei Buchstaben nur erste 2 Zeichen beachte

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Replace bei Buchstaben nur erste 2 Zeichen beachte

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

308 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread