Excel宏替换字符串部分。

Question

Excel宏替换字符串部分。

3

我遇到了一个问题，需要替换包含注释的一段数据中字符串的部分内容。如果出现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 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的行，并且对没有其他文本的单元格正常工作。可惜的是，对于其他单元格，它无法仅替换需要替换的三位数字，并且会破坏单元格中的数据。下面的代码可以处理前两个单元格，但后面的单元格效果不佳。请帮忙解决。

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

- Dave F

需要替换的那一行是否总是包含“ID”或其他字符串？它们是否总是以“123456789”或“123 456 789”的形式出现？ - Comintern

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Wiktor Stribiżew · Accepted Answer

我删除了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

这是结果:

输入图像描述