[英]Excel macro to replace part of string
I'm having trouble replacing part of a string in a range of data that includes comments. 我在一系列包含注释的数据中替换部分字符串时遇到了问题。
Where ID numbers appears, I need to replace the middle of the ID numbers with Xs (eg 423456789
to become 423xxx789
). 出现ID号时,我需要用X替换ID号的中间位置(例如
423456789
变为423xxx789
)。 The IDs only ever start with 4
or 5
and any other number should be ignored as it may be necessary for other purposes. ID只能从
4
或5
开始,任何其他数字都应该被忽略,因为它可能是其他目的所必需的。
Sadly, because these are comments the data is inconsistently formatted which adds a level of complexity. 遗憾的是,因为这些是评论,所以数据格式不一致,这增加了一定程度的复杂性。
Representative data would look like the following: 代表性数据如下所示:
523 123 123
523123123
ID 545 345 345 is Mr. Jones
Primary ID 456456456 for Mrs. Brown
Mr. Smith's Id is 567567567
I need the code to only replace the middle 3 digits of the ID number and leave the rest of the cell intact so that 我需要代码只替换ID号的中间3位数字,并保持单元格的其余部分完好无损
ID 545 345 345 is Mr. Jones
Primary ID 456456456 for Mrs. Brown
Becomes (with or without spaces around the X
s) 成为(在
X
周围有或没有空格)
ID 545 xxx 345 is Mr. Jones
Primary ID 456xxx456 for Mrs. Brown
The regex I have is finding the lines with IDs successfully, and works nicely for the cells with no other text. 我的正则表达式是找到ID成功的行,并且对于没有其他文本的单元格很有效。 Sadly, for the other cells it will not replace just the 3 digits that need replacing and makes a mess of data the cell.
可悲的是,对于其他单元格而言,它不会仅仅取代需要替换的3位数字,而是使单元格数据混乱。 My code below works for the first two cells above, then doesn't work so well for the remainder.
我的代码适用于上面的前两个单元格,然后对其余单元格的工作效果不佳。 Please help.
请帮忙。
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
I removed the Do... While
loop and changed the logics in your For Each cell In Myrange
code so as to process matches one by one and create a specific replacements if we have non-empty value in the first or fourth capturing group (we can choose which values to choose for replacement then). 我删除了
Do... While
循环,并For Each cell In Myrange
代码中更改了For Each cell In Myrange
的逻辑,以便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
Here is the result: 结果如下:
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.