ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: 13907933959

[求助] 查找段落中重复药名标红并记数

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-28 09:19 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
duquancai 发表于 2019-7-27 13:48
你的需求 不断的改变!下次想清楚了,一次性吐完吧!按照你这次的需求写的,请测试!

杜前辈好!
只能对您再说声抱歉!我知道每一个代码都是各位前辈的辛勤付出,我从来都是怀着敬畏和感恩之心!我也知道代码写成后,求助者更改诉求是大忌!之所以出现这么的笔误,一是自己不够严谨。二是一心两用(在医院当班虽较“清闲”,但也时不时有病人前来打扰)的结果,只能恳求前辈们见谅!
前辈对我是大度和格外照顾的,每次都能援手相帮,这使我很感动!
“3天的消防演习”结束了,对我来说的“假期”也结束了,由于时间关系,30、32楼的代码看了,以后有空测试,30楼的代码在标记重复数,有的有2个是什么意思?32楼的代码标记重复数标红了,让前辈费心了!34楼的代码只粗测了一下,结果准确、以达心意!以后有空再仔细测试。感谢前辈!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-28 09:21 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
gbgbxgb 发表于 2019-7-27 13:06
这样的题有深挖掘的必要?显然,可完成目标任务的代码就是好代码,难道要把它写成一个软件?
另:楼主早 ...

gbgbxgb前辈好!
和杜前辈说的话同样对您说一遍,恳求您见谅!
前辈、前几个代码统计结果和我刚开始的要求(不减去标注“重复”字样的本身这一个)确实有误,我也列举了出来,后来我说“描述”有重大笔误,是忘了要减去标注“重复”字样的本身这一个。
由于时间关系,33楼附件中的代码只粗测了一下,结果准确、以达心意!以后有空再仔细测试(因单测试附件中1000多个药名,每个手工查找一遍,恐怕要几个小时)。感谢前辈多次援手相帮!谢谢!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-28 09:22 | 显示全部楼层
本帖最后由 13907933959 于 2019-7-29 07:39 编辑
413191246se 发表于 2019-7-27 11:56
* 139,我的最新版本《Word2003 & 2007 VBA 自动排版宏(集成版)2019-7-9》中的 2003 版本代码,希望你选 ...

师傅好!
好的、这个《经典代码》我没有掌握,前2年跟师傅和前辈们学的一点皮毛,由于天资和努力不够,再加上整天整夜的学和背中医的东西,现在以忘得差不多了,这很对不起师傅!没有办法,生存的压力大过任何的兴趣和爱好!
师傅的几个代码我也一样等有空再细测,不然等我的中医师傅看到不好,又要挨骂!
感谢师傅为我做的一切!我的中医师傅休息了3天又要来盯我们了,恐怕又没时间来论坛了,如回复不了望师傅见谅!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-28 10:30 | 显示全部楼层
本帖最后由 13907933959 于 2019-7-29 06:53 编辑
duquancai 发表于 2019-7-27 13:48
你的需求 不断的改变!下次想清楚了,一次性吐完吧!按照你这次的需求写的,请测试!
多回了一个,删除。

TA的精华主题

TA的得分主题

发表于 2019-7-28 12:04 | 显示全部楼层
139:从 Excel 表格对比结果来看,最终,如果从标红角度来讲,gbgbxgb 老师、duquancai 老师和我的代码执行后结果都是正确的;但从执行时间来看,最快速的当属 gbgbxgb 老师,所以,你可以采用 gbgbxgb 老师的代码完成最终定稿(但请注意:gbgbxgb 老师的代码中“重复项 -1”,把这个“-1”删除,就和我的代码执行结果一样了)。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-7-29 06:52 | 显示全部楼层
本帖最后由 13907933959 于 2019-7-29 07:00 编辑
413191246se 发表于 2019-7-28 12:04
139:从 Excel 表格对比结果来看,最终,如果从标红角度来讲,gbgbxgb 老师、duquancai 老师和我的代码执行 ...

师傅好!
好的、gbgbxgb 老师这个代码吗?是要删除下面红色代码中的 – 1 吗?

Sub SearchDuplicateStr()
    Dim theStr$, d As Object, i&, j&,theStrTemp$
    Dim reg As Object, theMatches As Object,theMatch As Variant
    '
    Set d =CreateObject("Scripting.Dictionary")
    Set reg =CreateObject("VBScript.RegExp")
    With reg
        .Global = True
        .MultiLine = True
        .Pattern = "^[^、]+"
    End With
    With ActiveDocument
        .Content.Find.Execute "(重复[!^13]{1,}", , ,True, , , , , , , wdReplaceAll
        .Range.Font.ColorIndex = wdAuto
        theStr = .Range
        Set theMatches = reg.Execute(theStr)
        For Each theMatch In theMatches
            theStr = theMatch
            d(theStr) = d(theStr) + 1
        Next theMatch
        reg.Global = False
        theStr = .Range
        For i = 0 To d.Count - 1
            j = d.items()(i)
            If j > 1 Then
                theStrTemp = d.keys()(i)
                reg.Pattern = "^"& theStrTemp & "、"
                theStrTemp = theStrTemp &"、(重复"& j - 1 & "个)"
                theStr = reg.Replace(theStr,theStrTemp)
            End If
        Next i
        .Range = theStr
        .Range(.Range.End - 1,.Range.End).Delete
        For Each theMatch In .Paragraphs
            With theMatch
                theStr = .Range
                If InStr(1, theStr, "(") = 0 Then
                    theStr = Replace(theStr,"、","")
                    theStr = Left(theStr,Len(theStr) - 1)
                    If d(theStr) > 1 Then.Range.Font.ColorIndex = wdRed
                End If
            End With
        Next theMatch
    End With
    Set theMatches = Nothing
    Set theMatch = Nothing
    Set d = Nothing
End Sub

TA的精华主题

TA的得分主题

发表于 2019-7-29 08:26 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
一般情况下,挤几次牙膏,修改几次命题都是家常便饭了,哈哈哈,淡定!

TA的精华主题

TA的得分主题

发表于 2019-7-29 14:19 | 显示全部楼层
ming 老师 露面了! 139,是的,j - 1 "个"把“-1”去掉就成了,你可以用 gbgbxgb 老师的代码完成最终定稿。

TA的精华主题

TA的得分主题

发表于 2023-1-30 09:04 | 显示全部楼层
413191246se 发表于 2019-7-27 01:57
* 楼上图片及EXCEL数据有错!
*
* 如果哪位老师看到,对不起!我弄错了,现更正如下:(原来“山刺梨”和 ...

https://club.excelhome.net/thread-1650662-1-1.html求助
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-27 19:08 , Processed in 0.042559 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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