Excelmacrosreplace部分string
我无法replace包含注释的一系列数据中的部分string。
在身份证号码出现的地方，我需要用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
我需要的代码只能取代身份证号码的中间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
我有正则expression式find成功的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
我删除了Do... While循环，并更改了For Each cell In Myrange的逻辑For Each cell In Myrange代码中， For Each cell In Myrange处理匹配项，并在第一个或第四个捕获组中使用非空值时创build特定的replace项可以select要replace的值）。
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
结果如下：
