如何为 VBA 查找/替换脚本设置某种数组

Posted 2023-04-19

【中文标题】如何为 VBA 查找/替换脚本设置某种数组

【英文标题】：How to set some sort of array for VBA find/replace scripts

【发布时间】：2012-05-17 20:35:33

【问题描述】：

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

Option Explicit
'Dim strMacroName As String
 Dim spellingcorrectionsrep As Long

 Public Sub SpellingReview()
 Dim oShell, MyDocuments

'声明 MyDocs 文件路径： 设置 oShell = CreateObject("Wscript.Shell") MyDocuments = oShell.SpecialFolders("MyDocuments") 设置 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

【问题讨论】：

您的字典是固定大小、具有固定值的（因此您可以对每个单词进行硬编码）还是从其他地方获取？

【参考方案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

【讨论】：

工作起来就像一个魅力，非常简单。非常感谢你，我的朋友！

在我的第一篇文章开头有没有类似于我的代码的东西？我尝试将其设置为类似于此回复，但它不喜欢“wordrep = wordrep + 1”，我需要跟踪结果，因为它会增加每个“找到”实例，我最终将其写入用于跟踪的 INI 文件。

你在顶部声明了吗？ Dim wordrep as Long 还是您的意思是完成的替换总数？

这就是我的意思。 .但是，这可能是一个愚蠢的问题，但是我怎样才能使 wordRep 变量在主示例 sub 中传回/可用，因为那是我的脚本的其余部分？

声明它在顶部，在程序之外，就像我在上面所做的那样。

【参考方案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

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

【讨论】：

我不能完全让这个工作正常，但非常感谢您的回复。

【参考方案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