vba 用于查找多个字符串并在每次出现的末尾插入文本（特定于每个字符串）的宏

Macro to find multiple strings and insert text (specific to each string) at the end of each occurrence

提问by user2691384

The scenario:

场景：

Word documents that contain a selection of sentences (strings). There might be up to 30 possible strings (which vary from 5 to 20 words in length). The document will contain only a selection of these strings.

包含一系列句子（字符串）的 Word 文档。可能有多达 30 个可能的字符串（长度从 5 到 20 个单词不等）。该文档将仅包含这些字符串的一部分。

Aim:

目的：

Macro that searches through the document, finds each occurrenceof a particular string and inserts a specific text code(such as " (ACWD2553)") aftereach occurrence. This is repeated for all the other strings in the set, with each different string having it's own distinct code. Some strings won't be in the document. The strings can be located in document body and table cells. The macro would then be applied to other documents which would have different selections of the strings.

搜索文档、查找特定字符串的每次出现并在每次出现后插入特定文本代码（例如“(ACWD2553)”）的宏。对集合中的所有其他字符串重复此操作，每个不同的字符串都有自己独特的代码。某些字符串不会出现在文档中。字符串可以位于文档正文和表格单元格中。然后该宏将应用于其他具有不同字符串选择的文档。

I have tried for many days using selection.find, content.find, target.list, insertafter and so on but only with one case and still ran into numerous problems (e.g. only inserting in one instance, or code repeatedly inserting until Word freezes).

我已经尝试了很多天使用 selection.find、content.find、target.list、insertafter 等，但只有一种情况，仍然遇到了很多问题（例如，只在一个实例中插入，或者代码重复插入直到 Word 冻结） .

Bonus feature ###

奖励功能###

Be able to choose which set of strings which will be searched for (there are potentially up to 60 sets) and their corresponding codes. Each document would only have strings from one set.

能够选择要搜索的字符串集（可能多达 60 集）及其相应的代码。每个文档只有一组中的字符串。

An idea I had was for the strings to be listed in a column (in Excel?) and the matching codes in the a second column. The macro would then search the document for each string in the list (stopping at the end of the list since the number of strings varies between sets) finds the matching code in the cell in the next column and then inserts the code for each occurrence of the string in the word doc. When a different set is required, the Excel file could be swapped with the file containing the relevant set of stings, but with the same file name. Or all sets in the one Excel file on different worksheets and tab name entered in Word (userform?) which forces search of relevant set. This file would be located on a network drive.

我的一个想法是将字符串列在列中（在 Excel 中？）和第二列中的匹配代码。然后宏将在文档中搜索列表中的每个字符串（在列表的末尾停止，因为字符串的数量因集合而异）在下一列的单元格中找到匹配的代码，然后为每次出现插入代码word doc 中的字符串。当需要不同的集合时，Excel 文件可以与包含相关字符串集的文件交换，但具有相同的文件名。或者在 Word（用户表单？）中输入的不同工作表和选项卡名称上的一个 Excel 文件中的所有集合，这会强制搜索相关集合。该文件将位于网络驱动器上。

Not sure if this is bigger then Ben Hur, last bit would be nice, but I can also manually enter the strings in the raw code from a template code.

不确定这是否比 Ben Hur 大，最后一点会很好，但我也可以从模板代码手动输入原始代码中的字符串。

Edited this post to include my poor attempt at the code. See my comment below. I just realised that I could add code to this pane. Tried a variety of iterations of the one below, none of which worked well and which does not approach what I require. I know there are obvious errors, as I said below I have played around with the code and made it worse in the process by mixing bits and pieces together.

编辑了这篇文章以包括我对代码的糟糕尝试。看我下面的评论。我刚刚意识到我可以向这个窗格添加代码。尝试了下面的各种迭代，没有一个效果很好，也没有达到我的要求。我知道有明显的错误，正如我在下面所说的，我玩弄了代码，并通过将点点滴滴混合在一起使代码变得更糟。

Sub Codes()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("This is sentence 1", "This is string 2 which could be twenty words in length", "This is string three, there could be thirty more strings to search") ' put list of terms to find here

For i = 0 To UBound(TargetList)

Set range = ActiveDocument.range

With range.Find
.Text = TargetList(i)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

Do While .Execute(Forward:=True) = True
range.Find.Execute
range.InsertAfter Text:=" (ACWD1234)"

Loop

End With
Next

End Sub

回答by Graham Anderson

I think that this is a time to use replace rather than find, see implementation below. If the specific code changes depending on the target string you can hanlde this easily with a 2 dimensional array

我认为这是使用替换而不是查找的时候，请参阅下面的实现。如果特定代码根据目标字符串发生变化，您可以使用二维数组轻松处理

Sub Codes()

Dim i As Long
Dim TargetList
Dim MyRange As range
TargetList = Array("This is sentence 1", "This is string 2 which could be twenty words in length", "This is string three, there could be thirty more strings to search") ' put list of terms to find here
Dim sStringToAdd As String

sStringToAdd = " (ACWD2553)"

For i = 0 To UBound(TargetList)

Set MyRange = ActiveDocument.Content

MyRange.Find.Execute FindText:=TargetList(i), ReplaceWith:=TargetList(i) & sStringToAdd, _
    Replace:=wdReplaceAll


Next i

End Sub

回答by Renan Ranelli

The code below does exactly what you need. I dont know if replacing the whole Contents property of the document object has some weird effect into tabulation/formating and so on.

下面的代码正是您所需要的。我不知道替换文档对象的整个 Contents 属性是否对制表/格式等有一些奇怪的影响。

I'd rather not add any overhead with string/array/collection manipulations. Using find-replace is probably the most obvious route, but I don't like that whole lot of options you need to set (because I understand none of them =P)

我宁愿不增加任何字符串/数组/集合操作的开销。使用 find-replace 可能是最明显的路线，但我不喜欢您需要设置的大量选项（因为我不理解它们=P）

You need to add a reference to "Microsoft scripting runtime"

您需要添加对“Microsoft 脚本运行时”的引用

Public Sub changeTokens()
    Dim strContents                     As String
    Dim mapperDic                       As Scripting.Dictionary
    Dim thisTokenKey                    As String
    Dim varKey                          As Variant

    Set mapperDic = getTokenMapper()

    For Each varKey In mapperDic.Keys
        thisTokenKey = CStr(varKey)
        ThisDocument.Content = Replace(ThisDocument.Content, thisTokenKey, mapperDic(thisTokenKey))
    Next varKey
End Sub

Public Function getTokenMapper() As Scripting.Dictionary
    ' This function can fetch data from other sources to buidl up the mapping.
    Dim tempDic                         As Scripting.Dictionary
    Set tempDic = New Scripting.Dictionary


    Call tempDic.Add("Token 1", "Token 1 changed!!")
    Call tempDic.Add("Token 2", "Token 1 changed!!")
    Call tempDic.Add("Token 3", "Token 1 changed!!")

    Set getTokenMapper = tempDic
End Function

You can fetch your data to create the mapper dictionary from a excel worksheet with no problems.

您可以毫无问题地从 Excel 工作表中获取数据以创建映射器字典。

回答by user2691384

Thanks to the two respondents. I don't have the skillset to progress the second code. I ended up searching for reading data from Excel into a word document and found code that worked perfectly.

感谢两位答主。我没有完成第二个代码的技能。我最终搜索从 Excel 读取数据到 word 文档中，并找到了完美运行的代码。

Using Excel as data source in Word VBA http://social.msdn.microsoft.com/Forums/office/en-US/ca9a31f4-4ab8-4889-8abb-a00af71d7307/using-excel-as-data-source-in-word-vbaCode produced by Doug Robbins.

在 Word VBA 中使用 Excel 作为数据源 http://social.msdn.microsoft.com/Forums/office/en-US/ca9a31f4-4ab8-4889-8abb-a00af71d7307/using-excel-as-data-source-in-由 Doug Robbins 制作的word-vba代码。

This worked an absolute treat. Also it means that I can edit the Excel file for the different sets of statements and their matching codes. Now it would be particularly sweet if I could work out a way to create a userform that would open when i run the macro and select the appropriate woprksheet based on the userform dropdown list item selected.

这绝对是一种享受。这也意味着我可以为不同的语句集及其匹配代码编辑 Excel 文件。现在，如果我能找到一种方法来创建一个用户窗体，该用户窗体将在我运行宏并根据所选用户窗体下拉列表项选择适当的 woprksheet 时打开，那将是特别甜蜜的。