Excel VBA 使用正则表达式查找和屏蔽 PAN 数据以实现 PCI DSS 合规性
Excel VBA to find and mask PAN data using regex for PCI DSS compliance
由于大多数在文件系统中发现信用卡数据的工具不再列出可疑文件，因此需要工具来屏蔽必须保留的文件中的任何数据。
对于可能存在大量信用卡数据的 excel 文件，我设计了一个宏，它使用正则表达式检测所选 column/row 中的信用卡数据，并将中间的 6-8 位数字替换为Xs 对很多人都有用。遗憾的是，我不是正则表达式宏 space 的专家。
下面基本上仅适用于 3 个品牌的正则表达式，并且如果 PAN 位于包含其他数据（例如评论字段）的单元格中则适用
以下代码有效，但可以改进。最好改进正则表达式，使其适用于 more/all 卡品牌，并通过包含 LUHN 算法检查来减少误报。
Improvements/Problems 剩余：
- 使用扩展的正则表达式匹配所有卡品牌的 PAN
- 包括 Luhn 算法检查（已修复 - 好主意 Ron）
- 改进 Do While 逻辑（由 stribizhev 修复）
- 更好地处理不包含 PAN 的单元格（已修复）
这是我目前所拥有的，似乎适用于 AmEx、Visa 和万事达卡：
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
休假回来。这是一个简单的 VBA 函数，它将测试 LUHN 算法。参数是一串数字；结果是布尔值。
它生成校验和数字并将该数字与您输入的数字字符串中的数字进行比较。
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
由于大多数在文件系统中发现信用卡数据的工具不再列出可疑文件，因此需要工具来屏蔽必须保留的文件中的任何数据。
对于可能存在大量信用卡数据的 excel 文件，我设计了一个宏，它使用正则表达式检测所选 column/row 中的信用卡数据，并将中间的 6-8 位数字替换为Xs 对很多人都有用。遗憾的是，我不是正则表达式宏 space 的专家。
下面基本上仅适用于 3 个品牌的正则表达式，并且如果 PAN 位于包含其他数据（例如评论字段）的单元格中则适用
以下代码有效，但可以改进。最好改进正则表达式，使其适用于 more/all 卡品牌，并通过包含 LUHN 算法检查来减少误报。
Improvements/Problems 剩余：
- 使用扩展的正则表达式匹配所有卡品牌的 PAN
- 包括 Luhn 算法检查（已修复 - 好主意 Ron）
- 改进 Do While 逻辑（由 stribizhev 修复）
- 更好地处理不包含 PAN 的单元格（已修复）
这是我目前所拥有的，似乎适用于 AmEx、Visa 和万事达卡：
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
休假回来。这是一个简单的 VBA 函数，它将测试 LUHN 算法。参数是一串数字；结果是布尔值。
它生成校验和数字并将该数字与您输入的数字字符串中的数字进行比较。
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