如何将Code字段后随机数字通过查找替换统一替换为固定星号串

需求说明 #

我有若干格式为"Code": "12345678910"的记录，需要将"Code":后跟随的所有数字统一替换为"*****************"。

输入示例 #

"Code": "19991319184199999"
"Code": "29999134313199999"
"Code": "39941313199929999"
"Code": "99993113119199999"
"Code": "99913319923199999"
"Code": "21421513114141451"

注："Code":后的数字均为随机值。

期望输出示例 #

"Code": "*****************"
"Code": "*****************"
"Code": "*****************"
"Code": "*****************"
"Code": "*****************"
"Code": "*****************"

现有问题 #

现有VBA代码仅支持固定内容的1:1替换，无法适配随机数字的替换场景，原有代码如下：

Option Explicit
Option Compare Text

Public Sub Testing()
    Dim t As Double
    t = Timer()
    Dim SearchRange As Range
    
    Set SearchRange = ThisWorkbook.Sheets(1).Range("A:A")
    
    ReplaceValues SearchRange
    Debug.Print Timer() - t
End Sub
Public Function GetReplacements() As Object
    Set GetReplacements = CreateObject("Scripting.Dictionary")
    
    With GetReplacements
    
.Add "Code: 9999999999", "Test"

    End With
    
End Function

Public Sub ReplaceValues(ByVal RangeToSearch As Range)
    
    Dim cellValues As Variant
    cellValues = RangeToSearch.Value2
    
    Dim i As Long
    Dim j As Long
    Dim Replacements As Object
    Dim Replacement As Variant
    
    Set Replacements = GetReplacements()
    
    'Herhaal de array
    For i = LBound(cellValues) To UBound(cellValues)
        
        For j = LBound(cellValues, 2) To UBound(cellValues, 2)
            
            For Each Replacement In Replacements
                'Controleer of we kunnen vinden wat er bestaat, vervang daarna
                If InStr(1, cellValues(i, j), Replacement) > 0 Then
                    cellValues(i, j) = Replace(cellValues(i, j), Replacement, Replacements.Item(Replacement))
                End If
            Next
        
        Next
        
    Next
    
    RangeToSearch = cellValues
    
End Sub

解决方案 #

使用正则匹配替换即可适配随机数字的场景，调整后的代码如下：

Option Explicit
Option Compare Text

Public Sub Testing()
    Dim t As Double
    t = Timer()
    Dim SearchRange As Range
    
    Set SearchRange = ThisWorkbook.Sheets(1).Range("A:A")
    
    ReplaceValues SearchRange
    Debug.Print Timer() - t
End Sub

Public Sub ReplaceValues(ByVal RangeToSearch As Range)
    ' 后期绑定正则对象，无需提前引用库
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    ' 匹配规则："Code": 加任意空格 加引号 加任意长度数字 加引号
    regEx.Pattern = """Code"":\s*""\d+"""
    regEx.Global = True
    
    Dim cellValues As Variant
    cellValues = RangeToSearch.Value2
    
    Dim i As Long
    Dim j As Long
    
    For i = LBound(cellValues) To UBound(cellValues)
        For j = LBound(cellValues, 2) To UBound(cellValues, 2)
            If Not IsEmpty(cellValues(i, j)) Then
                cellValues(i, j) = regEx.Replace(cellValues(i, j), """Code"": ""*****************""")
            End If
        Next
    Next
    
    RangeToSearch.Value2 = cellValues
    Set regEx = Nothing
End Sub

代码说明 #

• 正则规则中的\s*适配冒号后可能存在的空格，\d+匹配任意长度的数字，不需要提前知道数字的具体值
• 保留了原有批量读取单元格到数组处理的逻辑，处理效率和原有代码一致

内容的提问来源于stack exchange，提问作者Stackoverflow Test