ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2019函数公式学习大典 不用妈妈陪默写神器 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2016实战技巧学习锦囊 WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 5957|回复: 16

[Excel 程序开发] [第44期]删除字符串中连续的重复词

[复制链接]

TA的精华主题

TA的得分主题

发表于 2009-1-25 12:52 | 显示全部楼层 |阅读模式
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) 来验证一下你的代码运行结果是否正确

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?免费注册

x

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-1-25 14:22 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
~~~~~~~~
站位!!

第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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-1-26 09:58 | 显示全部楼层
版主:
邮件已发,占位
根据您的提示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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-1-26 14:20 | 显示全部楼层
钻了一个空子,用了一个跳转语句,不知算不算数!

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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-1-28 03:49 | 显示全部楼层
邮件发送,跟贴占位。
给大家拜年啦,新年大吉大利。
  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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-2-5 12:15 | 显示全部楼层
邮件已发送,跟贴占位

第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

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-2-5 13:06 | 显示全部楼层
不用循环,有点难度,先占个位吧,已经用循环搞定了。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-2-5 15:36 | 显示全部楼层
捡个红包,呵呵。
  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
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-2-6 10:29 | 显示全部楼层
这题使用基础操作几步就搞定,可是用VBA,对我还有难度,啃一下,争取弄个答案出来。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2009-2-5 22:50 | 显示全部楼层
发件人: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

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-19 17:09 , Processed in 0.070939 second(s), 22 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表