如何設置某種排序的VBA查找/替換腳本

Question

更新後的腳本我正在使用該原因導致LOCKUP ...我嘗試用（Replace：= wdReplaceAll）替換（Replace：= wdReplaceOne），但仍然沒有運氣：

Option Explicit 
'Dim strMacroName As String 
Dim spellingcorrectionsrep As Long 

Public Sub SpellingReview() 
Dim oShell, MyDocuments 

「的聲明文件路徑MyDocs： 設置oShell =的CreateObject（ 「Wscript.Shell」） 我的文檔= oShell.SpecialFolders（ 「我的文檔」） 設置oShell =無

' 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 

Answer 1

爲什麼不使用它作爲一個共同的程序杜熱？

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 

Answer 2

創建陣列來存儲信息，是不是太硬

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 

當我想你的第一個例子中，它似乎並沒有全部更換的情況下，只有一個每分運行所以無論我做錯了或不正確的東西（或其並不意味着這樣做）

Answer 3

'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