查找段落中重复药名标红并记数

13907933959

ming0018 发表于 2019-7-26 16:12
这是我根据gbgbxgb的思路又写了一份代码，和gbgbxgb的区别在于，不会改成原文档的格式，缺点就是速度会 ...

前辈好！万分感谢！
我粗测了一下您10楼修改的代码，慢是慢一点，但能满足要求，查重的结果准确。
我只测了“梨”、“梅”、“柑”这3个药材，等明天有空继续测试。

13907933959

duquancai 发表于 2019-7-26 15:09
哦，纯文本，那楼上的大神写的完全可以了。我没必要再写。如果不是纯文本，倒是可以写一下代码。

前辈好！
别呀！您的正则是天下无敌！您是转治“疑难杂症”的高手，还望您能援手相助！谢谢！

duquancai

13907933959 发表于 2019-7-26 19:26
前辈好！
别呀！您的正则是天下无敌！您是转治“疑难杂症”的高手，还望您能援手相助！谢谢！

刚回到家，看了附件（每一段只有唯一的一种“药材”），是真实附件吗？如果是，哪里需要正则嘛？

13907933959

duquancai 发表于 2019-7-26 19:46
刚回到家，看了附件（每一段只有唯一的一种“药材”），是真实附件吗？如果是，哪里需要正则嘛？

前辈好！
是真实附件，用什么都可，反正能准确查重就成！

duquancai

13907933959 发表于 2019-7-26 19:52
前辈好！
是真实附件，用什么都可，反正能准确查重就成！

“柑”有三个哦！！！

13907933959

duquancai 发表于 2019-7-26 19:53
“柑”有三个哦！！！

前辈好！
“柑”、是3个，是我刚才测试时看错了。

weiyingde

gbgbxgb 发表于 2019-7-26 10:21
试试如下代码：

不错，效率最高。

weiyingde

ming0018 发表于 2019-7-26 15:42
我的代码效率太低，但我修改后的结果是和gbgbxgb一样的。
另外，需要标红的话，我修改了一下gbgbxgb的 ...

效率堪比第一楼，很好，赞一个！

zhanglei1371

我也来个简单版的：

1. Sub ffes()
   
2. Dim pa As Paragraph, strA$, strB$, s$, num%
   
3.     strA = ActiveDocument.Range.Text
   
4.     For Each pa In ActiveDocument.Paragraphs
   
5.         strB = Left(pa.Range.Text, Len(pa.Range.Text) - 1)
   
6.         If InStr(s, strB) = 0 Then
   
7.             num = UBound(Split(strA, strB))
   
8.             If num > 1 Then pa.Range.Text = strB & "(重复" & num & "次)" & vbNewLine
   
9.             s = s + strB
   
10.         End If
    
11.     Next
    
12. End Sub

复制代码

duquancai

13907933959 发表于 2019-7-26 19:52
前辈好！
是真实附件，用什么都可，反正能准确查重就成！

没时间考虑算法，也就不管效率了！！！

1. Sub main()
   
2.     Dim doc As Document, d As Object
   
3.     Set doc = ActiveDocument
   
4.     Call yuchuli(doc)
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     Call get_num(doc, d)
   
7.     Call mark_num(doc, d)
   
8. End Sub
   
9. Sub yuchuli(ByRef doc As Document)
   
10.     doc.Content.Find.Execute "、[!^13]@^13", , , -1, , , , , , "、^p", 2
    
11.     doc.Content.Find.Execute "^13{2,}", , , -1, , , , , , "^p", 2
    
12. End Sub
    
13. Sub get_num(ByVal doc As Document, ByRef d As Object)
    
14.     Dim p As Paragraph
    
15.     For Each p In doc.Paragraphs
    
16.         d(p.Range.Text) = d(p.Range.Text) + 1
    
17.     Next
    
18. End Sub
    
19. Sub mark_num(ByRef doc As Document, ByVal d As Object)
    
20.     Dim key, p As Range
    
21.     key = d.keys()
    
22.     Set p = doc.Content
    
23.     For i = 0 To UBound(key)
    
24.         If d(key(i)) > 1 Then
    
25.             With p.Find
    
26.                 If .Execute(key(i)) Then
    
27.                     With .Parent
    
28.                         .End = .End - 1: .InsertAfter "（重复" & d(key(i)) & "个）"
    
29.                         .Start = .End + 1
    
30.                     End With
    
31.                 End If
    
32.             End With
    
33.         End If
    
34.     Next
    
35. End Sub

复制代码