|
这段是在网上抄的代码,测试了一下是可以的
- Sub ABAB_AB()
-
- Dim RegExp As Object
- Dim SearchRange As Range, Cell As Range
-
- '此处定义正则表达式
- Set RegExp = CreateObject("vbscript.regexp")
- RegExp.Pattern = "(.)(?!\1)(.)\1\2"
-
- '此处指定查找范围
- Set SearchRange = ActiveSheet.Range("B2:B42558")
-
- '遍历查找范围内的单元格
- For Each Cell In SearchRange
- Set Matches = RegExp.Execute(Cell.Value)
- If Matches.Count >= 1 Then
- Set Match = Matches(0)
- Cell.Value = RegExp.Replace(Cell.Value, "$1$2")
- End If
- Next
-
- End Sub
复制代码 后来我自己改了一下,大概是这样的,发现性能很不行啊
可以看一下我的附件,如果是只有几个的话没有问题,但是数量一多(最后一确定按钮),整个就是死机的感觉啊,求大神优化啊
先感谢了
- Sub ABAB_AB()
-
- Dim RegExp As Object
- Dim SearchRange As Range, Cell As Range
-
- '此处定义正则表达式
- Set RegExp = CreateObject("vbscript.regexp")
- RegExp.Pattern = "(.)(?!\1)(.)\1\2"
-
- '此处指定查找范围
- Set SearchRange = ActiveSheet.Range("B2:B42558")
-
- '遍历查找范围内的单元格
- For Each Cell In SearchRange
- Set Matches = RegExp.Execute(Cell.Value)
- If Matches.Count >= 1 Then
- Set Match = Matches(0)
- Cell.Value = RegExp.Replace(Cell.Value, "$1$2")
- End If
- Next
-
- End Sub
- Sub ABB_ABBB()
-
- Dim RegExp As Object
- Dim SearchRange As Range, Cell As Range
-
- '此处定义正则表达式
- Set RegExp = CreateObject("vbscript.regexp")
- RegExp.Pattern = "(.)(?!\1)(.)\2"
-
- '此处指定查找范围
- Set SearchRange = ActiveSheet.Range("F2:F42558")
-
- '遍历查找范围内的单元格
- For Each Cell In SearchRange
- Set Matches = RegExp.Execute(Cell.Value)
- If Matches.Count >= 1 Then
- Set Match = Matches(0)
- Cell.Value = RegExp.Replace(Cell.Value, "$1$2$2$2")
- End If
- Next
-
- End Sub
- Sub ABB_AAB()
-
- Dim RegExp As Object
- Dim SearchRange As Range, Cell As Range
-
- '此处定义正则表达式
- Set RegExp = CreateObject("vbscript.regexp")
- RegExp.Pattern = "(.)(?!\1)(.)\2"
-
- '此处指定查找范围
- Set SearchRange = ActiveSheet.Range("J2:J42558")
-
- '遍历查找范围内的单元格
- For Each Cell In SearchRange
- Set Matches = RegExp.Execute(Cell.Value)
- If Matches.Count >= 1 Then
- Set Match = Matches(0)
- Cell.Value = RegExp.Replace(Cell.Value, "$1$1$2")
- End If
- Next
-
- End Sub
复制代码
ABAB_AB2.zip
(525.63 KB, 下载次数: 5)
|
|