Regex Excel VBA使用正则表达式查找和屏蔽PAN数据，以符合PCI DSS要求

由于在文件系统中发现信用卡数据的大多数工具都不会列出可疑文件，因此需要工具来屏蔽必须保留的文件中的任何数据

对于可能存在信用卡数据加载的excel文件，我认为使用regex在所选列/行中检测信用卡数据并用Xs替换中间的6-8位数的宏对许多人都很有用。遗憾的是，我不是正则表达式宏领域的大师

以下内容基本上仅适用于3个卡品牌的regex，如果PAN位于包含其他数据（例如注释字段）的单元格中，则可以使用

下面的代码可以工作，但可以改进。最好改进正则表达式，使其适用于更多/所有卡品牌，并通过包含LUHN算法检查来减少误报

剩余改进/问题：

• 将所有卡品牌的PAN与扩展的正则表达式匹配
• 包括Luhn算法检查（修复-好主意）
• 改进Do While逻辑（由Stribizev修复）
• 更好地处理不含PAN的单元格（固定）

以下是迄今为止我所拥有的似乎对美国运通、维萨和万事达卡都有效的信息：

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

子PCI_掩码_卡号（）
'写入以根据PCI DSS在excel文件中屏蔽信用卡号。
'突出显示Excel工作表中的信用卡数据，然后运行此宏。
作为字符串的Dim strPattern: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}）”
'上面PANs的正则表达式模式被分解为多个部分（在括号之间）
'因此，当正则表达式与PAN的第一部分匹配时，它将适合于其中一个rMatch（k）.子匹配（#），其中#是0、4、8、12、16、20或24。
“签证以4开头，长度为16位。通常，数据输入模式是四组四位数字
“万事达卡以5开头，长度为16位。通常，数据输入模式是四组四位数字
“美国运通以3开头，长度为15位。通常模式为4-6-5，但数据输入似乎不一致
将strReplace设置为字符串：strReplace=“”
“Dim regEx As New RegExp”如果使用此行而不是下一行，则需要手动启用MS VBS regEx v5.5。接下来的两行似乎是在脚本中完成的
Dim正则表达式作为对象
设置regEx=CreateObject（“VBScript.RegExp”）
Dim regEx作为新的RegExp
像弦一样的模糊的条纹
将Myrange变暗为Range
将纽潘变暗为字符串
把一个问题弄得像绳子一样模糊
暗蒙面一样长
模糊的问题
总长度
用正则表达式
.Global=True
.MultiLine=True
.IgnoreCase=False
.Pattern=strPattern'将正则表达式模式设置为与上面的模式匹配
以
设置Myrange=Selection
MsgBox（“宏现在将仅开始屏蔽选定单元格中标识的信用卡号码。如果选择了整列，则每列需要10-30秒才能完成。行同上。”）
对于Myrange中的每个单元格
总计=总计+1
“检查牢房是否可能容纳一个平底锅，而不仅仅是一个长号码
如果strPattern“”_
和cell.HasFormula=False_
左（cell.NumberFormat，1）“$”_
和Mid（cell.NumberFormat，3,1）“$”然后
“cell.NumberFormat=“@”
strInput=cell.Value
'根据与正则表达式模式匹配的数据，修复它
如果正则表达式测试（strInput），则
Set rMatch=regEx.Execute（strInput）
当k=0时，计数为-1
toReplace=rMatch（k）.值
'如果正则表达式匹配，则根据其正则表达式段替换PAN
选择案例2
案例Option Explicit
Function Luhn(sNum As String) As Boolean
'modulus 10 algorithm for various numbers
Dim X As Long, I As Long, J As Long

For I = Len(sNum) - 1 To 1 Step -2
    X = X + DoubleSumDigits(Mid(sNum, I, 1))
    If I > 1 Then X = X + Mid(sNum, I - 1, 1)
Next I

If Right(sNum, 1) = (X * 9) Mod 10 Then
    Luhn = True
Else
    Luhn = False
End If
End Function

Function DoubleSumDigits(L As Long) As Long
    Dim X As Long
    X = L * 2
    If X > 9 Then X = Val(Left(X, 1)) + Val(Right(X, 1))
    DoubleSumDigits = X
End Function