Da die meisten Tools zum Erkennen von Kreditkartendaten in Dateisystemen die verdächtigen Dateien nicht mehr auflisten, werden Tools benötigt, um alle Daten in Dateien zu maskieren, die beibehalten werden müssen.

Für Excel-Dateien, in denen möglicherweise viele Kreditkartendaten vorhanden sind, stelle ich mir ein Makro vor, das Kreditkartendaten in der ausgewählten Spalte / Zeile mithilfe von Regex erkennt und die mittleren 6-8 Ziffern durch Xs ersetzt. Dies wäre für viele hilfreich. Leider bin ich kein Guru im Regex-Makrobereich.

Das Folgende funktioniert grundsätzlich nur mit Regex für 3 Kartenmarken und funktioniert, wenn sich die PAN in einer Zelle mit anderen Daten befindet (z. B. Kommentarfelder).

Der folgende Code funktioniert, könnte aber verbessert werden. Es wäre gut, den regulären Ausdruck zu verbessern, damit er für mehr / alle Kartenmarken funktioniert, und False-Positives durch die Aufnahme einer LUHN-Algorithmusprüfung zu reduzieren.

Verbesserungen / verbleibende Probleme:

Match PANs aller Kartenmarken mit erweitertem RegexInclude Luhn Algorithmus Überprüfung (FIXED - gute Idee Ron) Verbessere die Do While-Logik (FIXED by stribizhev)elbst besserer Umgang mit Zellen, die keine PANs enthalten (FIXE

Hier ist, was ich bis jetzt habe, was für AmEx, Visa und Mastercard in Ordnung zu sein scheint:

Sub PCI_mask_card_numbers()
' Written to mask credit card numbers in excel files in accordance with PCI DSS.
' Highlight the credit card data in the Excel sheet, then run this macro.

Dim strPattern As String: strPattern = "([4][0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})|" & _
"([5][0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})|" & _
"([3][0-9]{2})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})|" & _
"([3][0-9]{3})([^a-zA-Z0-9_]?[0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})|" & _
"([3][0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})|" & _
"([3][0-9]{3})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{4})([^a-zA-Z0-9_]?[0-9]{3})|" & _
"([3][0-9]{3})([^a-zA-Z0-9_]?[0-9]{6})([^a-zA-Z0-9_]?[0-9]{5})"

' Regex patterns for PANs above are broken into multiple parts (between the brackets)
' As such the when regex matches the first part of a PAN will fit into one of rMatch(k).SubMatches(#) where # is 0, 4, 8, 12, 16, 20 or 24. 
' Visa start with a 4 and is 16 digits long. Typically the data entry pattern is four groups of four digits
' MasterCard start with a 5 and is 16 digits long. Typically the data entry pattern is four groups of four digits
' AmEx start with a 3 and is 15 digits long. Typically the pattern is 4-6-5, but data entry seems inconsistent

    Dim strReplace As String: strReplace = ""
'     Dim regEx As New RegExp  ' if this line is used instead of the next 2, the MS VBS RegEx v5.5 needs to be enabled manually. The next 2 lines seem to do it from within the script
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    Dim regEx As New RegExp
    Dim strInput As String
    Dim Myrange As Range
    Dim NewPAN As String
    Dim Aproblem As String
    Dim Masked As Long
    Dim Problems As Long
    Dim Total As Long

With regEx
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
    .Pattern = strPattern ' sets the regex pattern to match the pattern above
End With

Set Myrange = Selection

    MsgBox ("The macro will now start masking credit card numbers identified in the selected cells only. If entire columns are selected, each column will take 10-30 seconds to complete. Ditto for Rows.")

For Each cell In Myrange
    Total = Total + 1

    ' Check that the cell is a likely candidate for holding a PAN, not just a long number
    If strPattern <> "" _
    And cell.HasFormula = False _
    And Left(cell.NumberFormat, 1) <> "$" _
    And Mid(cell.NumberFormat, 3, 1) <> "$" Then
'        cell.NumberFormat = "@"
        strInput = cell.Value

        ' Depending on the data matching the regex pattern, fix it
        If regEx.Test(strInput) Then
            Set rMatch = regEx.Execute(strInput)
            For k = 0 To rMatch.Count - 1
                toReplace = rMatch(k).Value

        ' If the regex matched, replace the PAN based on its regex segment
                Select Case 2
                    Case Is < Len(rMatch(k).SubMatches(0))
                        strReplace = rMatch(k).SubMatches(0) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(3))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(4))
                        strReplace = rMatch(k).SubMatches(4) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(7))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(8))
                        strReplace = rMatch(k).SubMatches(8) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(11))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(12))
                        strReplace = rMatch(k).SubMatches(12) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(13))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(16))
                        strReplace = rMatch(k).SubMatches(16) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(19))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(20))
                        strReplace = rMatch(k).SubMatches(20) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(23))
                        Masked = Masked + 1
                    Case Is < Len(rMatch(k).SubMatches(24))
                        strReplace = rMatch(k).SubMatches(24) & "xxxxxxxx" & Trim(rMatch(k).SubMatches(26))
                        Masked = Masked + 1
                    Case Else
                        Aproblem = cell.Value
                        Problems = Problems + 1
                        ' MsgBox (Aproblem) ' only needed when curios
                End Select
                If cell.Value <> Aproblem Then
                    cell.Value = Replace(strInput, toReplace, strReplace)
                End If

            Next k
        Else
            ' Adds the cell value to a variable to allow the macro to move past the cell
            ' Once the macro is trusted not to loop forever, the message box can be removed
            ' MsgBox ("Problem. Regex fail? Bad data = " & Aproblem)
        End If
    End If
Next cell
' All done, tell the user
    MsgBox ("Cardholder data is now masked" & vbCr & vbCr & "Total cells highlighted (including blanks) = " & Total & vbCr & "Cells masked = " & Masked & vbCr & "Possible problem cells = " & Problems & vbCr & "All other cells were ignored")

End Sub