VB.NET Makro - Jahreszahlen bei Zensur auslassen?

  • Sonstige

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von DoSchwob.

    VB.NET Makro - Jahreszahlen bei Zensur auslassen?

    Hallo Leute, ich habe ein Makro geschrieben das Zahlenfolgen in einer Zelle zensiert, diese Zahlenfolgen sind 4 Stellig.

    Nun sind die Jahreszahlen das Problem, wenn im Feld steht



    "Herr xyz mit der Pesonalnummer 8293 hat 2009" wird es in

    "Herr xyz mit der Personalnummer **** hat **** " zensiert.

    Das ist auch der Sinn des Makros, Personalnummern in einer Tabelle zu zensieren, jedoch nicht die Jahreszahlen.

    Hier ist das Makro:

    ________________

    Private Function ziffernfolge_zensieren(ByVal xZeile As String) As String
    Dim MomentanePositionDesZeigers As Integer
    Dim AnzahlZeichenvonXZeile As Integer
    Dim AnzahlGefundeneZiffern As Integer
    Dim i As Integer ' Laufvariable
    Dim AuswertbaresZeichen As String
    Dim ZuErsetzenderString As String
    Dim ZuErsetzenderStringZeichen As String

    ziffernfolge_zensieren = ""
    xZeile = xZeile & " "
    AnzahlZeichenvonXZeile = Len(xZeile)

    For MomentanePositionDesZeigers = 1 To AnzahlZeichenvonXZeile Step 1

    AuswertbaresZeichen = Mid(xZeile, MomentanePositionDesZeigers, 1)

    If IsNumeric(AuswertbaresZeichen) Then

    ZuErsetzenderString = ZuErsetzenderString & AuswertbaresZeichen
    ZuErsetzenderStringZeichen = ZuErsetzenderStringZeichen & "*"

    Else
    If Len(ZuErsetzenderString) = 4 Then
    If Not IsNumeric(AuswertbaresZeichen) Then
    ziffernfolge_zensieren = Replace(ziffernfolge_zensieren, ZuErsetzenderString, ZuErsetzenderStringZeichen)
    ZuErsetzenderString = ""
    ZuErsetzenderStringZeichen = ""
    Else
    ZuErsetzenderString = ZuErsetzenderString & AuswertbaresZeichen
    ZuErsetzenderStringZeichen = ZuErsetzenderStringZeichen & "*"
    End If

    Else
    ZuErsetzenderString = ""
    ZuErsetzenderStringZeichen = ""
    End If


    End If

    ziffernfolge_zensieren = ziffernfolge_zensieren & AuswertbaresZeichen

    Next

    ziffernfolge_zensieren = Trim(ziffernfolge_zensieren)


    End Function

    Private Sub TestaufrufZiffernfolgeerstezen()
    Dim Uebergabestring, ergebnisstring As String
    Uebergabestring = "57 979977j 3353jkjfsdgjsdfk31.12.2009lgjklsdf3.2.99jgklsdf2011fghgh1.1.11jgkljsdfgkljsdflkgjklsdfjgklsdfjgkl3"
    ergebnisstring = ziffernfolge_zensieren(Uebergabestring)
    ergebnisstring = ergebnisstring
    End Sub

    __________

    Kann mir einer von euch sagen wo ich was einbauen muss, damit die Zahlen 1990,1991,1992 etc. bis 2020 ausgelassen werden?

    Vielen Dank für eure Antworten.

    Dein Problem ist weiteres aus dem anderen Thema von dir. Dazu hatte ich dir nen Post gemacht, einfach gehalten und ihn jetzt kurz mit deiner neuen Anforderung erweitert. Der Code müsste verständlich sein. Hier noch mal die Anleitung:

    "Setzt das in ein Modul. Danach markierst du deine Einträge, die du ersetzen willst und führst mit Alt+F8 dann das Makro Test aus. Fertig. exitRow verhindert, dass er ne komplett markierte Spalte komplett durchgeht, er bricht am Ende der Daten ab."


    Visual Basic-Quellcode

    1. Option Explicit
    2. Sub test()
    3. Dim exitRow As Long
    4. Dim myCell As Range
    6. exitRow = ActiveSheet.UsedRange.Rows.Count
    8. For Each myCell In Selection.Cells
    9. With myCell
    10. If .Value <> blubb(.Value) Then
    11. .Value = blubb(.Value)
    12. End If
    13. If exitRow = .EntireRow.Row Then Exit For
    14. End With
    16. Next
    17. End Sub
    18. Private Function blubb(ByVal strText As String) As String
    20. Dim i As Long
    21. Dim myArray As Variant
    23. If strText = "" Then Exit Function
    24. If InStr(1, Trim(strText), Space(1)) = 0 Then Exit Function
    26. myArray = Split(strText, Space(1))
    28. For i = LBound(myArray) To UBound(myArray)
    29. If Len(Len(myArray(i)) = 4 Or _
    30. Len(myArray(i)) = 5 Or _
    31. Len(myArray(i)) = 6) And IsNumeric(myArray(i)) Then
    33. If myArray(i) > 1990 And myArray(i) < 2020 Then
    34. 'ignorier Jahreszahl
    35. Else
    36. myArray(i) = String(6, "*")
    37. End If
    38. End If
    39. Next
    40. blubb = Join(myArray, Space(1))
    41. End Function