1

更新的脚本我正在使用导致锁定...我尝试用 (Replace:=wdReplaceAll) 替换 (Replace:=wdReplaceOne)，但仍然没有这样的运气：

Option Explicit
'Dim strMacroName As String
 Dim spellingcorrectionsrep As Long

 Public Sub SpellingReview()
 Dim oShell, MyDocuments

'声明 MyDocs 文件路径： Set oShell = CreateObject("Wscript.Shell") MyDocuments = oShell.SpecialFolders("MyDocuments") Set oShell = Nothing

'   Set values for variables of the actual word to find/replace
spellingsuggestionsrep = 0
spellingcorrectionsrep = 0

'   Replacements

SpellingCorrections "dog", "dog (will be changed to cat)", False, True

'    END SEARCHING DOCUMENT AND DISPLAY MESSAGE

MsgBox spellingcorrectionsrep

'strMacroName = "Spelling Review"
'Call LogMacroUsage(strMacroName)

 End Sub
  Sub SpellingCorrections(sInput As String, sReplace As String, MC As Boolean, MW As     Boolean)

'   Set Selection Search Criteria
Selection.HomeKey Unit:=wdStory
With Selection
     With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Highlight = True
    .Text = sInput
    .Replacement.Text = sReplace
    .Forward = True
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = False
    .MatchCase = MC
    .MatchWholeWord = MW
End With
Do While .Find.Execute = True
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If

    If .Find.Execute(Replace:=wdReplaceOne) = True Then
    spellingcorrectionsrep = spellingcorrectionsrep + 1
    End If
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
  Loop
  End With
 End Sub
4

3 回答 3

2

为什么不将其用作通用程序？

Option Explicit

Dim wordRep As Long

Public Sub SpellingReview()
    Dim oShell, MyDocuments

    wordRep = 0

    SpellingCorrections "Dog", "Dog (will be changed to DOG)", False, True

    MsgBox wordRep
End Sub

Sub SpellingCorrections(sInput As String, sReplace As String, MC As Boolean, MW As Boolean)
    With ActiveDocument.Content.Find
        Do While .Execute(FindText:=sInput, Forward:=True, Format:=True, _
           MatchWholeWord:=MW, MatchCase:=MC) = True
           wordRep = wordRep + 1
        Loop
    End With

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Highlight = True
        .Text = sInput
        .Replacement.Text = sReplace
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = MC
        .MatchWholeWord = MW
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
End Sub
于 2012-05-17T21:13:27.437 回答
0

创建一个数组来存储信息并不难

Dim Dict() As Variant
' Integer ReplacementCount, String FindText, Boolean MatchCase, Boolean MatchWholeWord, String ReplaceText
Dict = Array( _
            Array(0, "Word", True, True, "word"), _
            Array(0, "Word1", True, True, "word1"), _
            Array(0, "Word2", True, True, "word2"), _
            Array(0, "Word3", True, True, "word3") _
        )

使用它，您可以遍历每个项目并将替换计数器存储在同一个数组中。

For Index = LBound(Dict) To UBound(Dict)
    Do While ReplaceStuffFunction(WithArguments) = True
       Dict(Index)(0) = Dict(Index)(0) + 1
    Loop
Next Index

当我尝试您的第一个示例代码时，它似乎并没有替换所有实例，每次运行 sub 只替换一个，所以要么我做错了，要么不正确（或者它不打算这样做）

于 2012-05-17T22:20:53.890 回答
0 
'In this example, I used two arrays to shorten formal hospital names
'Define two arrays (I used FindWordArray and ReplacewordArray)
'The position of the word (by comma) in each arrays correspond to each other

Dim n as long
Dim FindWordArray, ReplaceWordArray As String 'Change information pertinent to your needs
Dim FWA() As String 'Find words array created by split function
Dim RWA() As String 'Replace array created by split function
Dim HospitalName As String 'This is the string to find and replace

FindWordArray = ("Hospital,Center,Regional,Community,University,Medical") 'change data here separate keep the quotes and separate by commas
FWA = Split(FindWordArray, ",")
ReplaceWordArray = ("Hosp,Cntr,Reg,Com,Uni,Med") 'change data here keep the quotes but separate by commas
RWA = Split(ReplaceWordArray, ",")
'Loop through each of the arrays
For n = LBound(FWA) To UBound(FWA)
    HospitalName = Replace(HospitalName, FWA(n), RWA(n))
Next n
于 2017-07-17T22:09:50.880 回答