[第44期]删除字符串中连续的重复词

Scarlett_88

第一次参赛。答案已发送

第四次发答案了，提供了40种写法。

1. 
   
2. Sub DBLDel()
   
3. Dim regEx As Object ' 建立变量
   
4. Set regEx = CreateObject("vbScript.RegExp") ' 建立正则表达式
   
5. regEx.Global = True '全程查找(若非全程查找则只进行一次匹配)
   
6. 'regEx.IgnoreCase = True ' 设置是否区分大小写
   
7. sourstr = [A1] & " "
   
8. regEx.Pattern = "\b((\w)+\s)?\1+" ' 要找的字符串,下面是40中表达式的写法
   
9. '\b([a-zA-Z0-9]+ )?\1+
   
10. '\b([!-~]+ )?\1+
    
11. '\b((\w)+\s)?\1+
    
12. '\b((\w)+ )?\1+
    
13. '\b([a-zA-Z0-9]+\s)?\1+
    
14. '\b([!-~]+\s)?\1+
    
15. '\b((\w*)\s)?\1+
    
16. '\b((\w*)\ )?\1+
    
17. '\b([!-~]* )?\1+
    
18. '\b(([!-~]*)\s)?\1+
    
19. '\b([a-zA-Z0-9]* )?\1+
    
20. '\b((\w)*\s)?\1+
    
21. '\b((\w)* )?\1+
    
22. '\b([a-zA-Z0-9]*\s)?\1+
    
23. '\b((\w+)\s)?\1+
    
24. '\b((\w+)\ )?\1+
    
25. '\b((.)+?\s)?\1+
    
26. '\b((.)+? )?\1+
    
27. '\b((.)*?\s)?\1+
    
28. '\b((.)*? )?\1+
    
29. '
    
30. '([a-zA-Z0-9]+\s)?\1+
    
31. '([!-~]+ )?\1+
    
32. '((\w)+\s)?\1+
    
33. '((\w)+ )?\1+
    
34. '([a-zA-Z0-9]+\s)?\1+
    
35. '([!-~]+\s)?\1+
    
36. '((\w*)\s)?\1+
    
37. '((\w*) )?\1+
    
38. '([!-~]* )?\1+
    
39. '(([!-~]*)\s)?\1+
    
40. '([a-zA-Z0-9]* )?\1+
    
41. '((\w)*\s)?\1+
    
42. '((\w)* )?\1+
    
43. '([a-zA-Z0-9]*\s)?\1+
    
44. '((\w+)\s)?\1+
    
45. '((\w+) )?\1+
    
46. '((.)+?\s)?\1+
    
47. '((.)+? )?\1+
    
48. '((.)*?\s)?\1+
    
49. '((.)*? )?\1+
    
50. sourstr = regEx.Replace(sourstr, "$1") ' 替换
    
51. [A1] = Trim(sourstr)
    
52. Set regEx = Nothing
    
53. End Sub

复制代码

后20个有误,LDYXCD XCD XCD XCDXCD LDY的结果不正确. 该程序的结果是LDYXCD XCDXCD LDY,但应该是LDYXCD XCD XCDXCD LDY
前20个表达式正确. 谢谢提供这么多的表达式供大家参考, 另加1分, 评3分. -willin2000

dxy27

答案已发送！

xowi99

答案已发送

1. Sub DBLDel()
   
2. Dim regEx As RegExp    '先期引用regExp对象
   
3. Dim str1 As String
   
4. Dim rg As Range
   
5. 'Dim regEx As Object    '如果没有引用中勾选regExp对象，则使用ctreatobject创建
   
6. 'Set regEx = CreateObject("vbScript.RegExp")
   
7. Set regEx = New RegExp
   
8. Set rg = Sheet1.Range("A1")
   
9. regEx.Global = True
   
10. str1 = rg.Value & " "
    
11. regEx.Pattern = "(\w+ )?\1+"
    
12. 'rg.Offset(1) = Trim(regEx.Replace(str1, "$1"))
    
13. rg = Trim(regEx.Replace(str1, "$1"))
    
14. Set regEx = Nothing
    
15. Set rg = Nothing
    
16. End Sub

复制代码

程序有误,LDYXCD XCD XCD XCDXCD LDY运行结果是LDYXCD XCDXCD LDY,但应该是LDYXCD XCD XCDXCD LDY. 评1分. -willin2000

chrisfang

凑个数，实在想不出好办法。

方法不正确, 不适用较多ID很多重复的情况. 不得分. -willin2000

willin2000

我的代码,也适用连接的空是多个的情况:

1. Sub DBLDel()
   
2. With CreateObject("VBSCRIPT.REGEXP")
   
3.     .IgnoreCase = True
   
4.     .Global = True
   
5.     .Pattern = "(\b\w+)(\s+\1\b)+"
   
6.     [a1] = .Replace([a1], "$1")
   
7. End With
   
8. End Sub

复制代码

以下代码能显示用分组查找到的各个串位置和串,供学习正则的网友参考:

1. '引用Microsfot VBScript Regular Expressions ?.?
   
2. Sub DBLDel()
   
3. Dim matches As MatchCollection
   
4. Dim RetStr$
   
5. With CreateObject("VBSCRIPT.REGEXP")
   
6.     .IgnoreCase = True
   
7.     .Global = True
   
8.     .Pattern = "(\b\w+)(\s+\1\b)+"
   
9.     Set matches = .Execute([a1])
   
10.     For Each Match In matches
    
11.         RetStr = RetStr & "Match found at position "
    
12.         RetStr = RetStr & Match.FirstIndex & ". Match Value is '"
    
13.         RetStr = RetStr & Match.Value & "'." & vbCrLf
    
14.     Next
    
15.     MsgBox RetStr
    
16.     [a1] = .Replace([a1], "$1")
    
17. End With
    
18. End Sub

复制代码

amulee

学习了，正则表达式好强大

ggmmlol

willin2000 发表于 2009-3-5 00:35
我的代码,也适用连接的空是多个的情况:

以下代码能显示用分组查找到的各个串位置和串,供学习正则的网友 ...

我的这个代码，不仅适应于连接的空格是多个的情况，而且还适应：
1、字符串开始和(或)结尾出现多个空格的情况，
2、重复项非连续的情况，
3、被空格分隔的ID包含汉字字符的情况。

1. Sub DBLDel()
   
2. With CreateObject("vbscript.regexp")
   
3. '    .Ignorecase = True'是否忽略大小写可根据条件定
   
4.     .Global = True
   
5.     .Pattern = ".*?( |^)([^ ]+)(?= *$|( ))(?!.* \2(?: |$))|.+"
   
6.     [a1] = .Replace([a1].Value, "$2$3")
   
7. End With
   
8. End Sub

复制代码

该正则表达式的详细分析，请参见：
[技巧]正则表达式万能公式应用实例：在一个字符串内按分隔符提取不重复项

http://club.excelhome.net/thread-1486825-1-1.html
(出处: ExcelHome技术论坛)