Sub PNr_ausblenden()
Dim LetzteZeile As Long
Dim lngINH As Long
Dim LaufZahlZeile As Long
Dim LaufZahlZeichen As Long
Dim strINHALT As String
Application.EnableEvents = False
Application.ScreenUpdating = False
With ActiveWorkbook
With .Sheets("Tabelle1") 'muß evtl. angepaßt werden auf realen Tabellennamen
LetzteZeile = .Cells(.Cells.Rows.Count, 12).End(xlUp).Row
For LaufZahlZeile = 1 To LetzteZeile
strINHALT = .Cells(LaufZahlZeile, 12)
For LaufZahlZeichen = 1 To Len(strINHALT)
If IsNumeric(Mid(strINHALT, LaufZahlZeichen, 1)) Then
If IsNumeric(Mid(strINHALT, LaufZahlZeichen, 5)) And Mid(strINHALT, LaufZahlZeichen + 4, 1) <> " " Then
strINHALT = Left(strINHALT, LaufZahlZeichen - 1) & "*****" & Right(strINHALT, Len(strINHALT) - LaufZahlZeichen - 4)
.Cells(LaufZahlZeile, 12) = strINHALT
Exit For
ElseIf IsNumeric(Mid(strINHALT, LaufZahlZeichen, 4)) And Mid(strINHALT, LaufZahlZeichen + 3, 1) <> " " Then
strINHALT = Left(strINHALT, LaufZahlZeichen - 1) & "****" & Right(strINHALT, Len(strINHALT) - LaufZahlZeichen - 3)
.Cells(LaufZahlZeile, 12) = strINHALT
Exit For
End If
End If
Next LaufZahlZeichen
Next LaufZahlZeile
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Severus
|