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

willin2000

1.答题前先请仔细阅读本版正式竞赛区运行规则说明.
2.请勿在跟贴中直接发答案(跟帖中如附答案一律不得分).
3.答案附件请以标准文件名格式发送至我的邮箱：willin2000@yahoo.cn

说明:
1.递归也算是循环的一种,所写的代码语句被重复执行即算循环.

提示:
1.请大家再用这个验证一下结果是否正确:
a a a a a a a a a a a a a a a a a b b b b b b b b b b b b b b b b b b b b b b b b b b c c c c c c c c c c c c c c c c c d d d d d d d d d d d d d d d d d

2.另外再用在A1中输入=REPT("bc ",499)&REPT("abc ",499)&REPT("cbc ",499) 来验证一下你的代码运行结果是否正确

HHAAMM

~~~~~~~~
站位！！

第5次修改的答案已发到willin2000@yahoo.cn

1. Sub DBLDel()
   
2. Dim regEx As Object
   
3.     Set regEx = CreateObject("VBSCRIPT.REGEXP")
   
4.     If Right([a1].Value, 1) <> " " Then [a1] = [a1].Value & " "
   
5.     regEx.Pattern = "([\S]+\s)\1+"
   
6.     regEx.IgnoreCase = False
   
7.     regEx.Global = True
   
8.     [a1] = Trim(regEx.Replace([a1], "$1"))
   
9. End Sub

复制代码

程序有误,LDYXCD XCD XCD XCDXCD LDY的结果不正确. 该程序的结果是LDYXCD XCDXCD LDY,但应该是LDYXCD XCD XCDXCD LDY,表达式不准确,但知道是正则法,春节题放宽,评1分 -willin2000

smhf_6

版主：
邮件已发，占位
根据您的提示1提示2已于今天修改后重新发送2009.2.3

1. Sub DBLDel()
   
2. Dim str$
   
3. str = Cells(1, 1).Value
   
4. If Right(str, 1) <> " " Then
   
5. str = str & " "
   
6. End If
   
7. With CreateObject("VBSCRIPT.REGEXP")
   
8. .IgnoreCase = True
   
9. .Global = True
   
10. .Pattern = "(\b\w+\b\s+)(\1+)"         '
    
11.   Cells(1, 1) = .Replace(str, Split("$1")(0))
    
12. End With
    
13. End Sub

复制代码

yangchun88

钻了一个空子,用了一个跳转语句,不知算不算数!

只要你编写的某一语句会被一次以上运行就是循环.
另外请不要在回帖中写和答案有关的内容  -willin2000

xiangchendub

邮件发送，跟贴占位。
给大家拜年啦，新年大吉大利。

1. Sub DBLDel()
   
2.     Dim RegEx As Object
   
3.     Set RegEx = CreateObject("VBScript.RegExp")
   
4.     With RegEx
   
5.         .Global = True
   
6.         .Pattern = "\b(\w+)(?:(\s)\1\b)+"
   
7.     End With
   
8.     [a1] = RegEx.Replace([a1], "$1")
   
9. End Sub

复制代码

linpansheng

邮件已发送，跟贴占位

第3次修改，发送到你邮箱。以第3次的为准。谢谢周版主了。

修改了第3次了。

1. Sub DBLDel()
   
2. Dim reg As Object
   
3. Dim str1 As String
   
4. str1 = [a1]
   
5. Set reg = CreateObject("VBScript.RegExp")
   
6.   reg.Global = True
   
7.   reg.Pattern = "\b([a-zA-Z0-9]+ )+?\1+\b"
   
8.   str1 = reg.Replace(str1, "$1")
   
9.   reg.Pattern = "\b([a-zA-Z0-9]+) \1\b"
   
10.   str1 = reg.Replace(str1, "$1")
    
11. [a1] = str1
    
12.   Set reg = Nothing
    
13. End Sub

复制代码

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

alanxujian

不用循环，有点难度，先占个位吧，已经用循环搞定了。

agstick

捡个红包，呵呵。

1. Sub DBLDel()
   
2. Dim RegEx
   
3. Set RegEx = CreateObject("VBSCRIPT.REGEXP")
   
4.     RegEx.Global = True
   
5.     RegEx.IgnoreCase = True
   
6.     RegEx.MultiLine = True
   
7.     RegEx.Pattern = "\b([A-Za-z0-9]+ )\1+"
   
8.     [a1] = RegEx.Replace([a1] & " ", "$1")
   
9.     Set RegEx = Nothing
   
10. End Sub

复制代码

neverquest

这题使用基础操作几步就搞定，可是用VBA，对我还有难度，啃一下，争取弄个答案出来。

mxqchina

发件人：mxqchina <mxqchina@foxmail.com> 查看添加      
时   间：2009年2月5日(星期四) 晚上10:49  纯文本 | 更多操作↓
收件人： willin2000 <willin2000@yahoo.cn>

已经发送答案...请斑竹查看。

1. Sub DBLDel()
   
2.     Dim x As String
   
3.     Dim Regex As New VBScript_RegExp_55.RegExp
   
4.     With Regex
   
5.         .Global = True
   
6.         .Pattern = "(\w+\s+)\1+"
   
7.     End With
   
8.     x = Regex.Replace(Range("a1").Value & " ", "$1")
   
9.     Range("a1").Value = Left(x, Len(x) - 1)
   
10.     Set Regex = Nothing
    
11.     Set Myrange = Nothing
    
12. End Sub

复制代码

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