regex - Excel宏替换部分字符串

Question

我在替换包含注释的一系列数据中的部分字符串时遇到问题。

在出现 ID 号码的地方，我需要将 ID 号码的中间替换为 X(例如，将 423456789 替换为 423xxx789)。 ID 只能以 4 或 5 开头，任何其他数字都应被忽略，因为其他目的可能需要它。

遗憾的是，由于这些是注释，数据的格式不一致，这增加了复杂性。

代表性数据如下所示:

523 123 123
523123123
ID 545 345 345 is Mr. Jones
Primary ID 456456456 for Mrs. Brown
Mr. Smith's Id is 567567567

我需要代码仅替换 ID 号的中间 3 位数字，并保持单元格的其余部分完好无损，以便

ID 545 345 345 is Mr. Jones 
Primary ID 456456456 for Mrs. Brown

变成(X 周围有或没有空格)

ID 545 xxx 345 is Mr. Jones 
Primary ID 456xxx456 for Mrs. Brown

我的正则表达式可以成功找到带有 ID 的行，并且对于没有其他文本的单元格效果很好。遗憾的是，对于其他单元格，它不会仅替换需要替换的 3 位数字，并且会使单元格中的数据变得困惑。我下面的代码适用于上面的前两个单元格，然后不适用于其余的单元格。请帮忙。

Sub FixIds()

Dim regEx As New RegExp
    Dim strPattern As String: strPattern = "([4][0-9]{2})([^a-zA-Z0-9_]?[0-9]{3})([^a-zA-Z0-9_]?[0-9]{3})|([5][0-9]{2})([^a-zA-Z0-9_]?[0-9]{3})([^a-zA-Z0-9_]?[0-9]{3})"
Dim strReplace As String: strReplace = ""
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

'Set RegEx config/settings/properties
    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 IDs identified in the selected cells only.")
' Start masking the IDs
    For Each cell In Myrange
        Total = Total + 1
        ' Check that the cell is long enough to possibly be an ID and isn't already masked
        Do While Len(cell.Value) > 8 And Mid(cell.Value, 5, 1) <> "x" And cell.Value <> Aproblem
            If strPattern <> "" Then

                cell.NumberFormat = "@"
                strInput = cell.Value
                NewPAN = Left(cell.Value, 3) & "xxx" & Right(cell.Value, 3)
                strReplace = NewPAN

' Depending on the data, fix it
                If regEx.Test(strInput) Then
                    cell.Value = NewPAN
                    Masked = Masked + 1
                Else
                    ' Adds the cell value to a variable to allow the macro to move past the cell
                    Aproblem = cell.Value
                    Problems = Problems + 1
                    ' 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
        Loop
    Next cell

' All done
MsgBox ("IDs are now masked" & vbCr & vbCr & "Total cells highlighted (including blanks) = " & Total & vbCr & "Cells masked = " & Masked & vbCr & "Problem cells = " & Problems)
End Sub

Answer 1

我删除了 Do...While 循环，并更改了 For Each cell In Myrange 代码中的逻辑，以便逐一处理匹配项并创建特定的如果我们在第一个或第四个捕获组中有非空值，则替换(然后我们可以选择要替换的值)。

For Each cell In Myrange
    Total = Total + 1
    ' Check that the cell is long enough to possibly be an ID and isn't already masked

        If strPattern <> "" Then

            cell.NumberFormat = "@"
            strInput = cell.Value

            ' Depending on the data, fix it
            If regEx.test(strInput) Then
              Set rMatch = regEx.Execute(strInput)
              For k = 0 To rMatch.Count - 1
                 toReplace = rMatch(k).Value
                 If Len(rMatch(k).SubMatches(0)) > 0 Then ' First pattern worked
                   strReplace = rMatch(k).SubMatches(0) & "xxx" & Trim(rMatch(k).SubMatches(2))
                 Else ' Second alternative is in place
                   strReplace = rMatch(k).SubMatches(3) & "xxx" & Trim(rMatch(k).SubMatches(5))
                 End If
                 cell.Value = Replace(strInput, toReplace, strReplace)
                 Masked = Masked + 1
               Next k
            Else
                ' Adds the cell value to a variable to allow the macro to move past the cell
                Aproblem = cell.Value
                Problems = Problems + 1
                ' 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

结果如下: