Textteile löschen

Chris · 2020-08-25T13:10:39+00:00

Hallo, wie kann ich folgendes am besten machen ich möchte z.B. den Text bM0690 durch " - " ersetzen. Mein Problem ist allerdings, ich möchte alle Texte ersetzen, die aus bM und einer Ziffernfolge bestehen, egal welche und wieviele Ziffern. Wie geht das? Gruß Christian

Hallo,


Sub bM()
Dim rngC As Range
Dim strText As String, strTmp As String
Dim i As Integer, j As Integer
Application.ScreenUpdating = False
With Sheets(1)
For Each rngC In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
strText = vbNullString
If rngC Like "*bM?*" Then
strText = rngC
For i = 1 To Len(strText) - 2
If Mid(strText, i, 2) = "bM" Then
strTmp = "bM"
For j = i + 2 To Len(strText)
If IsNumeric(Mid(strText, j, 1)) Then
strTmp = strTmp & Mid(strText, j, 1)
Else
Exit For
End If
Next j
If Len(strTmp) Then
strText = Replace(strText, strTmp, "|")
strText = Replace(strText, " ", "")
strText = Replace(strText, "-", "")
strText = Replace(strText, "|", "-")
strTmp = Left(strText, 1)
For j = 2 To Len(strText)
If Mid(strText, j, 1) = UCase(Mid(strText, j, 1)) Then
strTmp = strTmp & " "
End If
strTmp = strTmp & Mid(strText, j, 1)
Next j
rngC = strTmp
Exit For
End If
End If
Next i
End If
Next rngC
End With
End Sub

Gruß
Rudi

man muss ein bisschen mehr anpassen als den Suchbegriff

Sub LunarScan()
Dim rngC As Range
Dim strText As String, strTmp As String
Dim i As Integer, j As Integer
Const strMatch As String = "LunarScan"
Application.ScreenUpdating = False
With Sheets(1)
For Each rngC In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
strText = vbNullString
If rngC Like "*" & strMatch & "?*" Then
strText = rngC
For i = 1 To Len(strText) - Len(strMatch)
If Mid(strText, i, Len(strMatch)) = strMatch Then
strTmp = strMatch
For j = i + Len(strMatch) To Len(strText)
If IsNumeric(Mid(strText, j, 1)) Then
strTmp = strTmp & Mid(strText, j, 1)
Else
Exit For
End If
Next j
If Len(strTmp) Then
strText = Replace(strText, strTmp, "|")
strText = Replace(strText, " ", "")
strText = Replace(strText, "-", "")
strText = Replace(strText, "|", "-")
strTmp = Left(strText, 1)
For j = 2 To Len(strText)
If Mid(strText, j, 1) = UCase(Mid(strText, j, 1)) Then
strTmp = strTmp & " "
End If
strTmp = strTmp & Mid(strText, j, 1)
Next j
rngC = strTmp
Exit For
End If
End If
Next i
End If
Next rngC
End With
End Sub

Forumthread: Textteile löschen

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Textteile löschen

Forumthread: Textteile löschen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread