完全披露:我对VBA有些新手,而且还使用正则表达式。我知道为什么我的代码不能完成我想要的任何事情,但如何来实现它。
我正在尝试搜索工作簿中所有电话号码的所有工作表,并将其替换为“(XXX)XXX-XXXX ”。
我找到了一些有用的线程,如果电话号码是单元格中唯一的值,设法让它工作,但如果电话号码是较大字符串的一部分,则它不会检测到它。即使它确实如此,我也不确定如何在替换期间保留原始存在于每个单元格值中的其余信息,因为现在它将替换整个单元格值。
理想情况下,我想让替换文本(但不是整个单元格)显示为粗体并显示为红色,以引起注意它已被替换的事实,但我不是确定如何使用RegEx完成此任务。
最后,(这就是我让它更复杂的地方... )是否可以将数组中的更改记录到另一个工作表? 例如“Sheet1; Cell A1改为:'披萨送货的数量是123-456-7890。'到'数字是(XXX)XXX-XXXX用于披萨送货。'“显然,上述搜索需要修改以排除日志工作表。
到目前为止,这是我的代码:
Dim StrPattern As String: StrPattern = "^\s*(?:\+?(\d{1,3}))?[-. (]*(\d{3})[-. )]*(\d{3})[-. ]*(\d{4})(?: *x(\d+))?\s*$"
Dim StrReplace As String: StrReplace = "(XXX)XXX-XXXX"
Dim RegEx As New RegExp
Dim StrInput As String
Dim WS As Worksheet
Dim Rng As Range
Dim CL As Range
For Each WS In ActiveWorkbook.Worksheets
For Each Rng In WS.UsedRange
For Each CL In Rng
StrInput = CL.Value
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = StrPattern
End With
If RegEx.Test(StrInput) Then
CL.Value = (RegEx.Replace(StrInput, StrReplace))
End If
Next CL
Next Rng
Next WS
答案 0 :(得分:0)
基本上是的; SJR的原始建议是删除" ^"从一开始就是" $"从最后工作来识别电话号码,无论电池是否包含额外的内容。他的后续建议,以简化模式没有。
代码仍然需要一些工作,因为RegEx模式正在尝试搜索可能以多种不同方式格式化的电话号码,例如使用或不使用" 1"在前。现在,如果一个单元格中存在所有电话号码,结果就像预期的那样。但是,如果单元格中存在其他文本,则会在结果中删除电话号码前后的空格。即:"该号码是(XXX)XXX-XXXX用于披萨送货。"如果我尝试通过在StrReplace的开头和结尾添加空格来进行补偿,则空格会显示在电话号码所在的单元格的结果中。即:" (XXX)XXX-XXXX"
我想我可以用另一个if语句来解决它,但是如果有人知道这个问题的答案以及我希望结果大胆的话,我很乐意听到它。< / p>
编辑:
我想出来并使用以下内容合并了粗体红色字体:
Dim StrPattern As String: StrPattern = "(?:\+?(\d{1,3}))?[-. (]*(\d{3})[-. )]*(\d{3})[-. ]*(\d{4})(?: *x(\d+))?"
Dim StrReplace As String: StrReplace = "(XXX)XXX-XXXX"
Dim RegEx As New RegExp
Dim StrInput As String
Dim WS As Worksheet
Dim Rng As Range
Dim CL As Range
Dim IntStartPos As Integer
Dim IntEndPos As Integer
Dim IntTestPos As Integer
Dim IntTotalLen As Integer
For Each WS In ActiveWorkbook.Worksheets
For Each Rng In WS.UsedRange
For Each CL In Rng
StrInput = CL.Value
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = StrPattern
End With
If RegEx.Test(StrInput) Then
CL.Value = (RegEx.Replace(StrInput, StrReplace))
IntTotalLen = Len(StrReplace)
IntStartPos = InStr(CL, StrReplace)
IntTestPos = 0
Do While IntStartPos > IntTestPos
With CL.Characters(IntStartPos, IntTotalLen).Font
.FontStyle = "Bold"
.ColorIndex = 3
End With
IntEndPos = IntStartPos + IntTotalLen
IntTestPos = IntTestPos + IntEndPos
IntStartPos = InStr(IntTestPos, CL, StrReplace, vbTextCompare)
Loop
End If
Next CL
Next Rng
Next WS