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

fypm1009

weiyingde 发表于 2020-2-16 22:17
你这个例子看不出效果，因为四个都不相同，换个例子或许可行。思路是第一次将找到的各项装入字典，
第二 ...

可能我的意图还是说的不够清楚， 是文章中会正文会有Aubin\upcite{A78}，则后文会有A78的人员介绍\bibitem{A78} Aubin，我是想核对前文中的Aubin是不是写正确了，然后对每个正文核对后进行颜色标注；

fypm1009

weiyingde 发表于 2020-2-16 22:17
你这个例子看不出效果，因为四个都不相同，换个例子或许可行。思路是第一次将找到的各项装入字典，
第二 ...

或者受累能不能给个有关类似装入字典再索引的例子

fypm1009

weiyingde 发表于 2020-2-16 22:17
你这个例子看不出效果，因为四个都不相同，换个例子或许可行。思路是第一次将找到的各项装入字典，
第二 ...

老师，我按照您的思路，自己写了一个，个人认为循环和正则都没问题了，但是最后选中标记的正则时有问题，老是选中整个WORD，望赐教指导

第二个正则后的if语句中，.Content.HighlightColorIndex = 5有点问题，不是匹配的该正则匹配项，而是全文

fypm1009

weiyingde 发表于 2020-2-14 15:02
重复的要不要算？

老师，我把我的代码传上去了，基本能实现，但是有点错误，有空给指导一下，谢谢   

fypm1009

每天顶一下，不要沉，其他老师有空再给指导一下

weiyingde

fypm1009 发表于 2020-2-19 14:27
每天顶一下，不要沉，其他老师有空再给指导一下

'你的代码思路不清，我再写了一个，你用我的例子测试。
Sub 再测试()
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 = "([A-Za-z]+)(\s\\upcite\{)([A-Z1-9]+)"
    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
                    .Range(.Range.Start + fst, .Range.Start + fst + lgh0).Font.ColorIndex = tm1(x1)
                 End If
             Next
             For x2 = 0 To UBound(KY2)
                 If mt.submatches(2) = KY2(x2) Then
                    .Range(.Range.Start + fst + lgh0 + lgh1, .Range.Start + fst + lgh0 + lgh1 + lgh2).Font.ColorIndex = tm2(x2)
                 End If
             Next
         Next
    End With
End Sub

FOB_FN_L

weiyingde 发表于 2020-2-19 19:41
'你的代码思路不清，我再写了一个，但你示例不典型，可能无法看到效果
Sub 再测试()
On Error Resume N ...

大佬，完善成一个自定义函数，这样通用性更强呀，也可重复利用~~您说是吧

weiyingde

FOB_FN_L 发表于 2020-2-19 19:53
大佬，完善成一个自定义函数，这样通用性更强呀，也可重复利用~~您说是吧

你用我上传的附件测试。不是自定义函数，而是公共过程。这个不难，简单改造一下就成了。

FOB_FN_L

Get strings on either side of special character.

'Here is a function that will get the string on each side of
'a string that is really two strings, with a special char in
'the center.



Function GetString(tmpStr As String, tmpDiv As String, Mode As String) As
String
Dim tmpRetStr As String
Dim tmpLen As Integer
Dim tmpErr As Integer
  '
  ' tmpString = The whole string
  ' tmpDiv = The Divider chr
  ' if mode = "F" then get the string in front of the div
  ' if mode = "B" then get the string in back of the div
  '
  ' Return values:
  '  Errors
  '    Err1 = wrong mode ("F" & "B" ok)
  '    Err2 =  No Div, did not found a divider
  '    Err3 = No F, did not find any string in front of the div
  '    Err4 = No B, did not find any string in back of the div
  '    Err5 = No String
  '  Normal
  '    String
  '
  ' Example: GetString("Red=Green","=","F") will retrun "Red"
  ' *** for string
  tmpErr = 0
  If Len(tmpStr) = 0 Then
    tmpErr = 5
    GoTo GetStringErr
  End If
  
  ' *** test for chr in tmpDiv
  If Len(tmpDiv) = 0 Then
    tmpErr = 2
    GoTo GetStringErr
  End If
  
  ' *** test for div in string
  If InStr(1, tmpStr, tmpDiv) = 0 Then
    tmpErr = 2
    GoTo GetStringErr
  End If
  
  ' *** process "F"
  If Mode = "F" Then
     tmpRetStr = Left(tmpStr, (InStr(1, tmpStr, tmpDiv) - 1))
     If Len(tmpRetStr) > 0 Then
       GetString = tmpRetStr
       Exit Function
     Else
       tmpErr = 3
       GoTo GetStringErr
     End If
  End If
  
  If Mode = "B" Then
     tmpRetStr = Right(tmpStr, Len(tmpStr) - (InStr(1, tmpStr, tmpDiv)))
     If Len(tmpRetStr) > 0 Then
       GetString = tmpRetStr
       Exit Function
     Else
       tmpErr = 4
       GoTo GetStringErr
     End If
  
  End If
    tmpErr = 1
    GoTo GetStringErr
  Exit Function
GetStringErr:
GetString = "Err" & tmpErr
End Function


VB中截取特定字符两边的一个自定义函数，完善一下就能成通用的了

fypm1009

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  ...

先谢谢，我是小白，感谢各位帮助，先谢过，再学习