首页 文章

如何在多个word文档中查找某个表并将其提取到单个Excel工作表中

提问于
浏览 次
1

我有一个包含大约300页单页文档的文件夹 . 每个文档包含大约3个表格和一些文本 . 例如，在每个文档中都有一个表名为“stackoverflow”的表 .

这是我的word文档示例的图像：

enter image description here

我有很多像这样的文档，但都是不同的，除了它们都有一个带有“stackoverflow”的表（如图中所示） .

我想要做的是将这些表中的所有名称从所有文档中提取到一个excel表 .

到目前为止我尝试的是这段代码：

Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Integer 'table number in Word
    Dim iRow As Long 'row index in Excel
    Dim iCol As Integer 'column index in Excel

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for file containing table to be imported")

    If wdFileName = False Then Exit Sub '(user cancelled import file browser)
        Set wdDoc = GetObject(wdFileName) 'open Word file

        With wdDoc
            TableNo = wdDoc.tables.Count
            If TableNo = 0 Then
                MsgBox "This document contains no tables", _
                vbExclamation, "Import Word Table"
            ElseIf TableNo > 1 Then
                TableNo = InputBox("This Word document contains " & TableNo & "     tables." & vbCrLf & _
                "Enter table number of table to import", "Import Word Table", "1")
            End If
            With .tables(TableNo)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                    Next iCol
                Next iRow
            End With
        End With
        Set wdDoc = Nothing
    End Sub

使用这段代码，我可以选择要提取到哪个表格excel，它完美地工作，除了我必须自己输入表格号并且它仅适用于一个文档 .

我还发现这段代码选择了一个包含特定字符串的表：

Sub Find_Text_in_table()
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "donec"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Do While Selection.Find.Execute
        If Selection.Information(wdWithInTable) Then
            Stop
            'now you are in table with text you searched
            'be careful with changing Selection Object
            'do what you need here
        End If
    Loop
End Sub

但我不确定如何将这两者结合起来 .

excel vba excel-vba ms-word

2 回答

  • 0

    第一个问题，打开多个文件：你想要Application.FileDialog（），如：https://msdn.microsoft.com/en-us/library/office/ff840210.aspx我碰巧在Publisher中使用它，但同样适用于：

    Sub InsertAndSizeWinners()

    Dim fd As FileDialog        ' File picker, to select images to insert.
    Dim nm As Variant           ' File name strings selected to insert.

    ' Create a FileDialog object as a File Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.Title = "Select documents"

    If fd.Show = -1 Then        ' 0 = Cancel, -1 = OK, got list.
        For Each nm In fd.SelectedItems  ' List of fully qualified file names.
            ProcessFilename nm  ' Process each c:\dir\path\file_name.jpg.
        Next nm
        MsgBox "All done. You can start arranging now."
    End If
    ' Else, user hit Cancel on file selection dialog box. Simply end.

End Sub

    这是一个非常简单的循环，它获取您指定的列表，然后调用子例程（ProcessFilename）来分别处理每个子例程 .

    回复于
  • 0

    我有类似的问题，我想我有你的解决方案 . 您将替换以下代码

    If TableNo = 0 Then
    MsgBox "This document contains no tables", _
    vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
    TableNo = InputBox("This Word document contains " & TableNo & "     tables." & vbCrLf & _
    "Enter table number of table to import", "Import Word Table", "1")
End If

    这个代码改为

    Dim myRow As Row
    Dim myCell As Cell
    Dim TargetTable As Long

    For x = 1 To wdDoc.ActiveDocument.Tables.Count
        For Each myRow In wdDoc.ActiveDocument.Tables(x).Rows
            For Each myCell In myRow.Cells
                If InStr(1, myCell.Range.Text, "stackoverflow", vbTextCompare) > 0 And _
                    TargetTable <> 0 Then MsgBox "More than one table matches description" & _
                                        "Table #" & TargetTable & " and table #" & x
                If InStr(1, myCell.Range.Text, "stackoverflow", vbTextCompare) > 0 Then TargetTable = x
            Next
        Next
    Next x
    TableNo = TargetTable

    我的代码所做的是遍历每个表的每一行的每个单元格，并在找到搜索到的文本时记录表索引 . 如果找到多个匹配项，它将警告您，但会使用找到的最后一个匹配项 .

    回复于

相关问题