【求助】查找WORD中特定字符串前后的字符并保存

weiyingde

FOB_FN_L 发表于 2020-2-19 19:58
Get strings on either side of special character.

'Here is a function that will get the string on  ...

Public Sub 标志前后同相同色(ptern As String)
On Error Resume Next
Dim colr As Integer
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
Set RegEx = CreateObject("VBscript.RegExp")
    RegEx.Pattern = ptern
    RegEx.Global = True
    RegEx.MultiLine = True
    With ActiveDocument
         sr = .Content.Text
         Set mh = RegEx.Execute(sr)
         For Each mt In mh
             If dic1.Exists(mt.submatches(0)) = False Then
                N = N + 1
                Nubr1 = IIf(N > 8, N Mod 8, N)
                dic1.Add mt.submatches(0), N * 2 + 1
             End If
             If dic2.Exists(mt.submatches(2)) = False Then
                M = M + 1
                Nubr2 = IIf(M > 8, M Mod 8, M)
                dic2.Add mt.submatches(2), M * 2
              End If
         Next
         ky1 = dic1.keys: tm1 = dic1.items
         KY2 = dic2.keys: tm2 = dic2.items
         For Each mt In mh
             fst = mt.firstindex
             lgh0 = Len(mt.submatches(0))
             lgh1 = Len(mt.submatches(1))
             lgh2 = Len(mt.submatches(2))
             For x1 = 0 To UBound(ky1)
                 If mt.submatches(0) = ky1(x1) Then
                    With .Range(.Range.Start + fst, .Range.Start + fst + lgh0)
                         .Font.ColorIndex = tm1(x1)
                         .Font.Name = "Arial Black"
                         .HighlightColorIndex = tm1(x1 + 1)
                    End With
                 End If
             Next
             For x2 = 0 To UBound(KY2)
                 If mt.submatches(2) = KY2(x2) Then
                    With .Range(.Range.Start + fst + lgh0 + lgh1, .Range.Start + fst + lgh0 + lgh1 + lgh2)
                         .Font.ColorIndex = tm2(x2)
                         .Font.Name = "Arial Narrow"
                         .HighlightColorIndex = tm2(x2 + 2)
                    End With
                 End If
             Next
         Next
    End With
End Sub
Sub 试试()
标志前后同项同色 "([A-Za-z]+)(\s\\upcite\{)([A-Z1-9]+)"
End Sub

fypm1009

weiyingde 发表于 2020-2-19 20:14
你看看怎么样，是否满足要求？请测试^^^^^^^^^^^^^^^
Public Sub 标志前后同项同色(ptern As String)
O ...

老师，谢谢，很强大；我要消化一段，认识一下每一句的意思；学习后我再修改一下

您理解我的描述还是有点出入，现在实现的还是只是Aubin \upcite{A78}，中的识别出Aubin是A78的，
我接下来想要比对\bibitem{A78}后面是不是也是Aubin,
例如
如果找到了\bibitem{A78} Aubin  则，原文中Aubin \upcite{A78}标为绿色；
如果找到了\bibitem{A78} Make  则，原文中Aubin \upcite{A78}标为红色；

也就是每个正文中会有作者和著作编号；文后会后 著作编号的作者介绍；我做的工作是想看下正文中写的作者名是否正确，

fypm1009

weiyingde 发表于 2020-2-19 20:14
Public Sub 标志前后同相同色(ptern As String)
On Error Resume Next
Dim colr As Integer

文件中会有好多作者和他的著作号；后文会有好多著作对应作者的介绍

weiyingde

fypm1009 发表于 2020-2-19 20:41
文件中会有好多作者和他的著作号；后文会有好多著作对应作者的介绍

其他的要求明天吧。

fypm1009

weiyingde 发表于 2020-2-19 21:00
其他的要求明天吧。

好的，不急，但是比较需要，这两天通过您的代码已经进步好多，非常感谢老师指导

FOB_FN_L

weiyingde 发表于 2020-2-19 20:14
Public Sub 标志前后同相同色(ptern As String)
On Error Resume Next
Dim colr As Integer

挺好的~~~赞666666下

weiyingde

你的表述还是不太清楚。你再说一下。

weiyingde

你这说的{A78} Aubin 是指确定的数值，还是一个形式的指代。
我帮你说一下，是不是这样的：
1、查找符合： 英文单词A+”\upcite{“(标志词)+两位数B【找到储存，以作对比】
2、查找符合：“\bibitem{“(标志词)+两位数B+英文单词A，找到了，就将“1、”里的英文单词A标成绿色，没有A就标成红色。
是不是这样理解？

weiyingde

fypm1009 发表于 2020-2-19 21:01
好的，不急，但是比较需要，这两天通过您的代码已经进步好多，非常感谢老师指导

按照28楼我的思路给你做了一个。
代码如下：
Sub 查找标色()
Dim booln As Boolean
Set regEx = CreateObject("VBscript.RegExp")
    regEx.Global = True
    regEx.MultiLine = True
    With ActiveDocument
         sr = .Content.Text
         regEx.Pattern = "([A-Za-z]+)(\s\\upcite\{)([A-Z1-9]+)"
         Set mah = regEx.Execute(sr)
         regEx.Pattern = "(\\bibitem{)([A-Z1-9]+)(\}\s)([A-Za-z]+)"
         Set Mat = regEx.Execute(sr)
         For Each mt1 In mah
             For Each mt2 In Mat
                 If mt1.submatches(2) = mt2.submatches(1) Then
                    booln = False
                    If mt1.submatches(0) = mt2.submatches(3) Then
                       booln = True
                    End If
                       With .Range(.Range.Start + mt1.firstindex, .Range.Start + mt1.firstindex + Len(mt1.submatches(0))).Font
                            .ColorIndex = IIf(booln = True, 11, 6)
                            .Name = IIf(booln = True, "Arial Black", "Arial Narrow")
                            .Bold = True
                       End With
                 End If
             Next
         Next
    End With
End Sub
如果“A78”也是标志词，则要对本程序略作修改。
应该说可以满足你的要求。
请测试。

fypm1009

weiyingde 发表于 2020-2-20 11:07
按照28楼我的思路给你做了一个。
代码如下：
Sub 查找标色()

谢谢老师，这下完全符合我的目标了，非常感谢老师的多次指导