Question

这是构建的一半，如果它令人困惑，那就很抱歉

我有这个代码，我在excel中定义了一个字典。从那里我想从Word文档中的“密钥”中找到文本，然后一旦发现我想继续进行其他编码。

问题是，我只是到了.find部分，我无法解决为什么它没有找到任何东西。

请注意以下几行：

For Each Key In Dict

我之后询问的是查找字符串C中的文字。我知道C包含一个值的事实，因为我添加了一个MsgBox来检查，我还将它添加到剪贴板中，所以我可以尝试手动查找文本 - 我如果我手动搜索

但是在运行/单步执行代码时，.find.execute命令似乎有点被忽略，好像它甚至没有尝试搜索文档而blnFound布尔每次都返回False，跳转到{ {1}}。我当时还在屏幕上显示文档（由代码打开），没有任何反应。

有人可以告诉我这里我做错了什么吗？我完全不知所措。

谢谢！

Next

PS。我也试过了

Sub FindReplaceInWord2()

    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim Wrd As New Word.Application
    Dim Dict As Object
    Dim RefList As Range, RefElem As Range
    Dim A As String
    Dim B As String
    Dim C As String
    Dim test As New DataObject
    Dim blnFound As Boolean    

    Wrd.Visible = True

    Dim TokenDoc As Document
    Set TokenDoc = Wrd.Documents.Open("\\SERVER\Client\Table.dot")        

    Set Dict = CreateObject("Scripting.Dictionary")
    Set RefList = Wbk.Sheets("Sheet1").Range("A1:A236") 

    With Dict
        For Each RefElem In RefList
        On Error Resume Next
            If Not .Exists(RefElem) And Not IsEmpty(RefElem) Then
            A = RefElem.Value
           .Add RefElem.Value, RefElem.Offset(0, 1).Value
            B = RefElem.Value

              End If
        Next RefElem
    End With

    For Each Key In Dict

    Set test = New DataObject
    'MsgBox Key
    test.SetText (Key)
    test.PutInClipboard
    C = Key
    MsgBox C
     With Wrd.ActiveDocument.Find

     .Text = C

    End With
   blnFound =  Wrd.ActiveDocument.Find.Execute        

        If blnFound = True Then
            MsgBox = "Yay for working it out"
            Else
        MsgBox = "Boo, it didn't Work"
        End If
    Next Key      

End Sub

并在查找之前添加此内容

   Wrd.Selection.Find.text = C
   blnFound = Wrd.Selection.Find.Execute

Answer 1

这是你正在尝试的（在本地模板文件上试验和测试）

Sub FindReplaceInWord2()
    Dim Wbk As Workbook: Set Wbk = ThisWorkbook
    Dim RefList As Range, RefElem As Range

    Dim col As New Collection
    Dim itm

    Dim blnFound As Boolean

    Dim Wrd As New Word.Application
    Dim TokenDoc As Document

    Wrd.Visible = True

    'Set TokenDoc = Wrd.Documents.Open("D:\Users\SidzPc\Desktop\Temp\Table.dot")
    Set TokenDoc = Wrd.Documents.Open("\\SERVER\Client\Table.dot")

    Set RefList = Wbk.Sheets("Sheet1").Range("A1:A236")

    For Each RefElem In RefList
        On Error Resume Next
        col.Add RefElem.Value, CStr(RefElem.Value)
        On Error GoTo 0
    Next RefElem

    For Each itm In col
        With Wrd.Selection.Find
            .Text = itm
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

        blnFound = Wrd.Selection.Find.Execute

        If blnFound = True Then
            MsgBox "Yay for working it out"
        Else
            MsgBox "Boo, it didn't Work"
        End If
    Next itm
End Sub

VBA在Excel文档中查找文本从Excel不工作 - 难倒

1 个答案: