Question

场景：

包含一系列句子（字符串）的Word文档。最多可能有30个字符串（长度从5到20个字不等）。该文档仅包含这些字符串的选择。

目的：

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

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

奖金功能###

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

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

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

编辑此帖以包含我对代码的不良尝试。请参阅下面的评论。我刚刚意识到我可以在此窗格中添加代码。尝试了以下各种迭代，其中没有一个能够很好地工作，并且没有达到我的要求。我知道有明显的错误，正如我在下面所说的那样，我已经玩过代码，并且通过混合零碎来使这个过程变得更糟。

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

Answer 1

我认为这是一个使用替换而不是查找的时间，请参阅下面的实现。如果特定代码根据目标字符串而改变，您可以使用二维数组轻松地进行此操作

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

Answer 2

以下代码完全符合您的需求。我不知道替换文档对象的整个Contents属性是否对制表/格式化等有一些奇怪的影响。

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

您需要添加对＆＃34; Microsoft脚本运行时＆＃34;

的引用

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

您可以从excel工作表中获取数据以创建映射器字典，没有任何问题。

Answer 3

感谢两位受访者。我没有技能来推进第二个代码。我最终搜索从Excel读取数据到word文档，并找到了完美的代码。

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

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

宏在每次出现结束时找到多个字符串并插入文本（特定于每个字符串）

场景：

目的：

奖金功能###

3 个答案: