Question

我希望有人可以帮我解决这个问题。

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

标题字幕

1. Name

   Address:

   Phone number:

2. Name

   Address:

   Phone number:

3. Name

   Address:

   Phone number:

在excel文件中，我在D列中有一个单词列表。我想要做的是从D列中取出单词，在Word文档中搜索它，然后从＆＃34;地址后复制句子：＆＃34;到＃34;。＆＃34;，把它放在C列（即左边的一个单元格），然后从＆＃34;电话号码后复制句子：＆＃34;到＆＃34;。＆＃34;并将其放在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

Answer 1

例如，下面的Excel子文件从位于与Excel文件相同的文件夹中的catalog.doc获取全文，使用RegExp解析文本，循环访问联系人并将其放入{{1然后循环遍历Dictionary个单元格，并将匹配名称的相应数据分别分配给D2:D10和C列。在MS Office 2003，Windows 7 HB中测试。

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

UPD：如果早期绑定出现任何问题，您可以按如下方式使用后期绑定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，但它不是VBA中的最佳做法：

CreateObject(ProgID)

excel宏搜索单词和复制句子

1 个答案: