Macos excel宏搜索单词并复制句子

我希望有人能帮我解决这个问题

我有两个文件，一个是Word，一个是Excel。在word文件中，我有一个项目列表，例如：

标题副标题

1. Name

   Address:

   Phone number:

2. Name

   Address:

   Phone number:

3. Name

   Address:

   Phone number:

在excel文件中，我在D列中有一个单词列表。我要做的是从D列中提取单词，在word文档中搜索它，然后将“Address:”后面的句子复制到“.”，将它放在C列（即，左边的一个单元格），然后将“Phone number:”后面的句子复制到“.”，然后将它放在B列

其中一个我不能完全理解的部分是从第一组姓名、地址和电话号码到下一组

有人能帮我解决这个问题吗

我想从以下几点扩展它：

Sub wordSearch()

' Purpose: display the text between (but not including)
' the words "Title" and "Address" if they both appear.
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strTheText As String

    Set rng1 = ActiveDocument.Range
    If rng1.Find.Execute(FindText:="Example:") Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Find.Execute(FindText:=".") Then
            strTheText = ActiveDocument.Range(rng1.End, rng2.Start).Text
            MsgBox strTheText
        End If
    End If

End Sub

---

例如，下面Excel的sub从与Excel文件位于同一文件夹中的

catalog.doc

获取全文，使用

RegExp

解析文本，循环遍历联系人并将其放入

字典中，然后循环遍历
D2:D10
单元格，并将匹配名称的适当数据分别分配给
C
和
B
列。在MS Office 2003、Windows 7 HB中测试

Option Explicit

Sub GetFromWord()

    ' Tools - References - add these:
    ' Microsoft Word 11.0 Object Library
    ' Microsoft VBScript Regular Expressions 5.5
    ' Microsoft Scripting Runtime

    Dim strCont As String
    Dim objCatalog As Scripting.Dictionary
    Dim objMatch As IMatch2
    Dim objElt As Range

    With New Word.Application
        .Documents.Open ThisWorkbook.Path & "\catalog.doc"
        With .ActiveDocument.Range
            .WholeStory
            strCont = .Text
        End With
        .Quit
    End With
    Set objCatalog = New Scripting.Dictionary
    With New RegExp
        .Pattern = "\d+\.[ \t]*([^\n\r]*)\s*Address:[ \t]*([^\n\r]*)\s*Phone number:[ \t]*([^\n\r]*)\s*"
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        For Each objMatch In .Execute(strCont)
            objCatalog.Add objMatch.SubMatches(0), Array(objMatch.SubMatches(1), objMatch.SubMatches(2))
        Next
    End With
    For Each objElt In Range("D2:D10")
        With objElt
            If objCatalog.Exists(.Cells(1, 1).Value) Then
                .Offset(0, -1) = objCatalog(.Cells(1, 1).Value)(0)
                .Offset(0, -2) = objCatalog(.Cells(1, 1).Value)(1)
            End If
        End With
    Next
End Sub

请注意，Word中重复的联系人将导致错误，不会执行其他检查

UPD:如果早期绑定出现任何问题，您可以按如下方式使用后期绑定
CreateObject（ProgID）
，但这不是VBA中的最佳做法：

Option Explicit

Sub GetFromWordLBind()

    Dim strCont As String
    Dim objCatalog, objMatch, objElt As Object

    With CreateObject("Word.Application")
        .Documents.Open ThisWorkbook.Path & "\catalog.docx"
        With .ActiveDocument.Range
            .WholeStory
            strCont = .Text
        End With
        .Quit
    End With
    Set objCatalog = CreateObject("Scripting.Dictionary")
    With CreateObject("VBScript.RegExp")
        .Pattern = "\d+\.[ \t]*([^\n\r]*)\s*Address:[ \t]*([^\n\r]*)\s*Phone number:[ \t]*([^\n\r]*)\s*"
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        For Each objMatch In .Execute(strCont)
            objCatalog.Add objMatch.SubMatches(0), Array(objMatch.SubMatches(1), objMatch.SubMatches(2))
        Next
    End With
    For Each objElt In Range("D2:D10")
        With objElt
            If objCatalog.Exists(.Cells(1, 1).Value) Then
                .Offset(0, -1) = objCatalog(.Cells(1, 1).Value)(0)
                .Offset(0, -2) = objCatalog(.Cells(1, 1).Value)(1)
            End If
        End With
    Next
End Sub

请澄清，有必要从Excel D列单元格中获取文本，然后在Word中找到名称与该文本完全相同的项目，并将电话和地址复制到Excel？您好，omegastripes，没错。您好，omegastripes，我尝试使用您对Word 97-2004（.doc）的修复我得到了以下编译错误：未定义用户定义的类型。它指向以下代码行：Dim objCatalog As Scripting.Dictionary如果我做错了什么，你能告诉我吗？此外，word文档的格式为2011年的word（.docx）。我需要改变什么吗？提前感谢您，并感谢您尝试一下。由于使用了早期绑定，您必须向项目中添加一些组件：在Excel VBA编辑器中打开项目，按
菜单
-
工具
-
参考
，然后检查我在代码开头列出的组件。选择适当版本的Word对象库（11.0对应于2003）。对于
*.docx
无需其他更改，只需指定实际文件名，而不是
catalog.doc
。您好，我收到以下错误：运行时错误429：无法创建ActiveX组件。使用CreateObject（“Word.Application”）时，调试器将突出显示。我做错什么了吗？那是意想不到的失败。。检查您的MS Office安装是否正确<代码>Word.Application
项必须存在于HKEY_CLASSES_根注册表分支中，才能使用该ProgID创建ActiveX实例。您是否尝试将引用添加到项目中以执行早期绑定（我回答中的第一个子项）？从
Word
|
Excel
-
菜单
-
-
帮助
-
关于
，您的MS Office版本是什么，我查看了“引用”选项，唯一可选择的选项是：Visual basic for applications Microsoft Excel 14.0对象库Microsoft forms 2.0对象库Microsoft office 14.0对象库Microsoft Visual basic of applications Microsoft word 14.0对象库图表14类型库Microsoft graph 14.0对象库Microsoft powerpoint 14.0对象库OLE自动化我使用的excel版本是：Microsoft excel for Mac 2011版本14.3.9这是一个带密钥的合法副本。再次感谢你的帮助。