Regex 替换部分字符串的Excel宏

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

在出现ID号的地方，我需要将ID号的中间部分替换为Xs（例如，

423456789

变成

423xx789

）。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

s周围有空格或没有空格）

我使用的正则表达式成功地找到了带有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

Sub-FixIds（）
Dim regEx作为新的RegExp
作为字符串的Dim strPattern: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}]
将strReplace设置为字符串：strReplace=“”
像弦一样的模糊的条纹
将Myrange变暗为Range
将纽潘变暗为字符串
把一个问题弄得像绳子一样模糊
暗蒙面一样长
模糊的问题
总长度
'设置RegEx config/settings/properties
用正则表达式
.Global=True
.MultiLine=True
.IgnoreCase=False
.Pattern=strPattern'将正则表达式模式设置为与上面的模式匹配
以
设置Myrange=Selection
MsgBox（“宏现在将仅开始屏蔽选定单元格中标识的ID。”）
'开始屏蔽ID
对于Myrange中的每个单元格
总计=总计+1
'检查单元格是否足够长，可能是一个ID，并且没有被屏蔽
当Len（cell.Value）>8和Mid（cell.Value，5，1）“x”和cell.Value出现问题时，请执行此操作
如果strPattern“”则
cell.NumberFormat=“@”
strInput=cell.Value
NewPAN=左（cell.Value，3）和“xxx”以及右（cell.Value，3）
strReplace=NewPAN
'根据数据，修复它
如果正则表达式测试（strInput），则
cell.Value=NewPAN
蒙面=蒙面+1
其他的
'将单元格值添加到变量，以允许宏移过单元格
Aproblem=单元格值
问题=问题+1
'一旦信任宏不会永远循环，则可以删除消息框
'MsgBox（“Problem.Regex fail？Bad data=“&Aproblem”）
如果结束
如果结束
环
下一个细胞
”“好了
MsgBox（“ID现在被屏蔽”&vbCr&vbCr&“高亮显示的总单元格数（包括空格）=“&Total&vbCr&”单元格屏蔽=“&masked&vbCr&”问题单元格=“&Problems”）
端接头

我删除了

Do。。。而

循环并更改了Myrange代码中每个单元格的

逻辑，以便逐个处理匹配项，并在第一个或第四个捕获组中有非空值时创建特定替换（我们可以选择要替换的值）

Myrange中每个单元格的

总计=总计+1
'检查单元格是否足够长，可能是一个ID，并且没有被屏蔽
如果strPattern“”则
cell.NumberFormat=“@”
strInput=cell.Value
'根据数据，修复它
如果正则表达式测试（strInput），则
Set rMatch=regEx.Execute（strInput）
当k=0时，计数为-1
toReplace=rMatch（k）.值
如果Len（rMatch（k）.SubMatches（0））>0，则第一个模式起作用
strReplace=rMatch（k）.子匹配（0）和“xxx”以及修剪（rMatch（k）.子匹配（2））
Else的第二个选择已经到位
strReplace=rMatch（k）.子匹配（3）和“xxx”以及修剪（rMatch（k）.子匹配（5））
如果结束
cell.Value=Replace（strInput、toReplace、strReplace）
蒙面=蒙面+1
下一个k
其他的
'将单元格值添加到变量，以允许宏移过单元格
Aproblem=单元格值
问题=问题+1
'一旦信任宏不会永远循环，则可以删除消息框
'MsgBox（“Problem.Regex fail？Bad data=“&Aproblem”）
如果结束
如果结束
下一个细胞

结果如下：

需要替换的行是否始终包含“ID”或其他字符串？它们总是以“123456789”或“123456789”的形式出现吗？天才。非常感谢。
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

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