Question

我学习了如何使用Microsoft Word通配符和代码来帮助我担任医学编辑。我的工作很大一部分是将手稿提交医学期刊进行审查，每种期刊都有非常具体的要求。

大多数期刊中，我们都会提交稿件，要求仅在使用3次或以上时才缩写医学用语/词组。例如，如果在文本中至少引用了3次，则术语“总体生存期”可以缩写为OS。如果文本仅提及“总体生存”一两次，则最好保留该术语的扩展，并且不应缩写为OS。

我们一直在通过Intelligent Editing使用PerfectIt系统。此Word小部件将扫描仅使用一次的缩写，并将其标记以供我们查看，但是如果在所选文本中仅使用两次缩写，则不会选择。我们希望找到某种解决方案（我认为这是某种通配符搜索或宏），将能够检测到缩写是否仅使用了一次或两次。

我看到了this similar post on stackoverflow，但这似乎与代码有关。我将需要将其安装在没有管理权限的公司计算机上，而且，我对代码一无所知。感谢您为进一步研究提供的帮助，指导或指示！

谢谢！

编辑：我可以使用通配符搜索，使用<[A-Z] {2，}>将所有两个以上的大写字母突出显示，然后将其格式化为突出显示的格式（如果这对任何宏都有帮助的话）。

Answer 1

对于任何给定的缩写，您可以使用如下宏：

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = InputBox("What is the Text to Find")
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub

有关PC宏安装和使用说明，请参见：http://www.gmayor.com/installing_macro.htm

有关Mac宏安装和使用说明，请参见：https://wordmvp.com/Mac/InstallMacro.html

Answer 2

假设在括号中至少有一种缩写出现，则可以使用如下所示的宏。宏检查文档的内容中是否包含大写/数字的括号缩写，然后向后看以尝试确定它们缩写的术语。例如：

万维网（WWW）

自然地，给定使用的首字母缩略词范围，它并不是万无一失的；如果不匹配，则会捕获前面的句子（以VBA术语），以便用户可以编辑输出。然后在文档末尾建立一个表格，然后在表格中搜索该首字母缩写词的所有引用（而不是定义），并将计数和页码添加到表格中。

但是请注意，宏不会告诉您“万维网”在文档中出现了多少次。毕竟，根据您的条件，不可能知道应该将哪些术语简化为首字母缩写词，而不是。

Sub AcronymLister()
Application.ScreenUpdating = False
Dim StrTmp As String, StrAcronyms As String, i As Long, j As Long, k As Long, Rng As Range, Tbl As Table
StrAcronyms = "Acronym" & vbTab & "Term" & vbTab & "Page" & vbTab & "Cross-Reference Count" & vbTab & "Cross-Reference Pages" & vbCr
With ActiveDocument
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .MatchWildcards = True
      .Wrap = wdFindStop
      .Text = "\([A-Z0-9]{2,}\)"
      .Replacement.Text = ""
      .Execute
    End With
    Do While .Find.Found = True
      StrTmp = Replace(Replace(.Text, "(", ""), ")", "")
      If (InStr(1, StrAcronyms, .Text, vbBinaryCompare) = 0) And (Not IsNumeric(StrTmp)) Then
        If .Words.First.Previous.Previous.Words(1).Characters.First = Right(StrTmp, 1) Then
          For i = Len(StrTmp) To 1 Step -1
            .MoveStartUntil Mid(StrTmp, i, 1), wdBackward
            .Start = .Start - 1
            If InStr(.Text, vbCr) > 0 Then
              .MoveStartUntil vbCr, wdForward
              .Start = .Start + 1
            End If
            If .Sentences.Count > 1 Then .Start = .Sentences.Last.Start
            If .Characters.Last.Information(wdWithInTable) = False Then
              If .Characters.First.Information(wdWithInTable) = True Then
                .Start = .Cells(.Cells.Count).Range.End + 1
              End If
            ElseIf .Cells.Count > 1 Then
              .Start = .Cells(.Cells.Count).Range.Start
            End If
          Next
        End If
        StrTmp = Replace(Replace(Replace(.Text, " (", "("), "(", "|"), ")", "")
        StrAcronyms = StrAcronyms & Split(StrTmp, "|")(1) & vbTab & Split(StrTmp, "|")(0) & vbTab & .Information(wdActiveEndAdjustedPageNumber) & vbTab & vbTab & vbCr
      End If
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
    StrAcronyms = Replace(Replace(Replace(StrAcronyms, " (", "("), "(", vbTab), ")", "")
    Set Rng = .Characters.Last
    With Rng
      If .Characters.First.Previous <> vbCr Then .InsertAfter vbCr
      .InsertAfter Chr(12)
      .Collapse wdCollapseEnd
      .Style = "Normal"
      .Text = StrAcronyms
      Set Tbl = .ConvertToTable(Separator:=vbTab, NumRows:=.Paragraphs.Count, NumColumns:=5)
      With Tbl
        .Columns.AutoFit
        .Rows(1).HeadingFormat = True
        .Rows(1).Range.Style = "Strong"
        .Rows.Alignment = wdAlignRowCenter
      End With
      .Collapse wdCollapseStart
    End With
  End With
  Rng.Start = ActiveDocument.Range.Start
  For i = 2 To Tbl.Rows.Count
    StrTmp = "": j = 0: k = 0
    With .Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = False
        .Forward = True
        .Text = "[!\(]" & Split(Tbl.Cell(i, 1).Range.Text, vbCr)(0) & "[!\)]"
        .MatchWildcards = True 
        .Execute
      End With
      Do While .Find.Found
        If Not .InRange(Rng) Then Exit Do
        j = j + 1
        If k <> .Duplicate.Information(wdActiveEndAdjustedPageNumber) Then
          k = .Duplicate.Information(wdActiveEndAdjustedPageNumber)
          StrTmp = StrTmp & k & " "
        End If
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With
    Tbl.Cell(i, 4).Range.Text = j
    StrTmp = Replace(Trim(StrTmp), " ", ",")
    If StrTmp <> "" Then
      'Add the current record to the output list (StrOut)
      StrTmp = Replace(Replace(ParseNumSeq(StrTmp, "&"), ",", ", "), "  ", " ")
    End If
    Tbl.Cell(i, 5).Range.Text = StrTmp
  Next
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

Function ParseNumSeq(StrNums As String, Optional StrEnd As String)
'This function converts multiple sequences of 3 or more consecutive numbers in a
' list to a string consisting of the first & last numbers separated by a hyphen.
' The separator for the last sequence can be set via the StrEnd variable.
Dim ArrTmp(), i As Long, j As Long, k As Long
ReDim ArrTmp(UBound(Split(StrNums, ",")))
For i = 0 To UBound(Split(StrNums, ","))
  ArrTmp(i) = Split(StrNums, ",")(i)
Next
For i = 0 To UBound(ArrTmp) - 1
  If IsNumeric(ArrTmp(i)) Then
    k = 2
    For j = i + 2 To UBound(ArrTmp)
      If CInt(ArrTmp(i) + k) <> CInt(ArrTmp(j)) Then Exit For
      ArrTmp(j - 1) = ""
      k = k + 1
    Next
    i = j - 2
  End If
Next
StrNums = Join(ArrTmp, ",")
StrNums = Replace(Replace(Replace(StrNums, ",,", " "), ", ", " "), " ,", " ")
While InStr(StrNums, "  ")
  StrNums = Replace(StrNums, "  ", " ")
Wend
StrNums = Replace(Replace(StrNums, " ", "-"), ",", ", ")
If StrEnd <> "" Then
  i = InStrRev(StrNums, ",")
  If i > 0 Then
    StrNums = Left(StrNums, i - 1) & Replace(StrNums, ",", " " & Trim(StrEnd), i)
  End If
End If
ParseNumSeq = StrNums
End Function

是否有MS Word通配符用于频率？

2 个答案: