Einen Teil eines Zelleninhalts ersetzen

Ciao Zäme
Ich benötige eure gütige Hilfe. Ich möchte innerhalb des Ranges O12:NO2993 bei jeder 19 Zeile den Zelleninhalt prüfen und ersetzen und zwar nur die ersten zwei Zeichen. Diese sind entweder leer oder hat mindestens 2 -8 Zeichen. Der Inhalt beginnt mit einer Zahl danach ein * und anschliessend eine 6stellige Auftragsnummer Beispiel 1*123456. Die ersten beiden Zeichen werden für die Farbgebung in der bedingten Formatierung verwendet. Nun habe ich das Problem, dass ich eine Anpassung vornehmen muss. Standard ersetzen geht da jeweils nur jede 19 Zeile verändert werden muss und in andern Zellen mit Formeleinträgen diese auch angepasst würden.
z.B. 1*123456 müsste 9*123456 und 2* 345678 müsste 7* 345678 heissen. Die Zahlenkombination nach * muss unbedingt beibehalten werden.
Habe ein verkleinertes Beispiel-File hochgeladen.
https://www.herber.de/bbs/user/133423.xlsx
Liebe Gruess
Richi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Richi,
hier sind 2 Makro-Varianten
einmal Zellenweise
einmal Blockweise mit suchen/ersetzen
LG
Franz

Sub Makro2()
Dim wks As Worksheet
Dim Zeile  As Long
Dim spa1 As Long, spa2 As Long, StatusCalc As Long
Dim rngZelle As Range
Set wks = ActiveSheet
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
spa1 = .Range("O1").Column
spa2 = .Range("NO1").Column
For Zeile = 12 To .UsedRange.Row + .UsedRange.Rows.Count - 1 Step 19
For Each Zelle In .Range(.Cells(Zeile, spa1), .Cells(Zeile, spa2)).Cells
stext = Zelle.Text
If Len(stext) >= 2 Then
Select Case Left(stext, 2)
Case "1*"
Zelle.Value = "9*" & Mid(stext, 3)
Case "2*"
Zelle.Value = "7*" & Mid(stext, 3)
End Select
End If
Next
Next
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
MsgBox "Ersetzen - Fertig"
End Sub
Sub Makro3()
' Makro2 Makro
Dim wks As Worksheet
Dim Zeile  As Long
Dim spa1 As Long, spa2 As Long, StatusCalc As Long
Set wks = ActiveSheet
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
With wks
spa1 = .Range("O1").Column
spa2 = .Range("NO1").Column
For Zeile = 12 To .UsedRange.Row + .UsedRange.Rows.Count - 1 Step 19
With .Range(.Cells(Zeile, spa1), .Cells(Zeile, spa2)).Cells
.Replace What:="1~*", Replacement:="9*", lookat:=xlPart
.Replace What:="2~*", Replacement:="7*", lookat:=xlPart
End With
Next
End With
With Application
.ScreenUpdating = True
.Calculation = StatusCalc
End With
MsgBox "Ersetzen - Fertig"
End Sub

Beliebteste Forumthreads (12 Monate)

Einen Teil eines Zelleninhalts ersetzen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Einen Teil eines Zelleninhalts ersetzen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread