2016-07-24 8 views
0

Ich habe einen Ordner mit etwa 300 einzelnen Seiten Word-Dokumente. Jedes Dokument enthält ungefähr 3 Tabellen und auch etwas Text. In jedem Dokument gibt es beispielsweise eine Tabelle mit dem Tabellennamen "stackoverflow". HierSo finden Sie eine bestimmte Tabelle in mehreren Word-Dokumenten und extrahieren sie in einem einzigen Excel-Blatt

ist ein Bild meines Word-Dokument Beispiel:
enter image description here

ich viele Dokumente wie diese haben, aber alle verschieden sind, mit Ausnahme der Tatsache, dass sie alle einen Tisch mit „Stackoverflow“ haben in es (wie auf dem Bild).

Was ich tun möchte, ist, alle Namen aus diesen Tabellen aus allen Dokumenten zu einem einzigen Excel-Blatt zu extrahieren.

Was habe ich versucht, so weit ist dieses Stück Code:

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 

Mit diesem Stück Code ich wählen kann, welche Tabelle I zu übertreffen extrahieren möchten, es funktioniert perfekt, außer der Tatsache, dass ich zu Geben Sie die Tischnummer selbst ein und das funktioniert nur für ein Dokument.

Ich fand auch dieses Stück Code, um eine Tabelle mit einer bestimmten Zeichenfolge im Innern wählen:

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 

Aber ich bin nicht sicher, wie diese 2.

+0

@ShareRado Dies ist, was ich gefunden/ausprobiert – Gromdroid

+0

Ist der Text "Tabelle 2: StackOverflow" tatsächlich in der Tabelle, oder ist es eine Art Beschriftung über der Tabelle? –

+0

Es ist irgendwie schwierig, in einigen Tabellen denke ich seinen Teil des Tisches, in anderen Tabellen eine Beschriftung darüber. Ich habe herausgefunden, dass entweder die Tabelle eine Beschriftung über ihr und "Name" und "adres" in ihr hat, sonst ist "Tabelle 2: Stackoverflow" in der Tabelle und hat keinen "Name" oder "adres" in der Tabelle. – Gromdroid

Antwort

0

Ich hatte ein ähnliches Problem zu kombinieren und ich denke, ich habe deine Lösung. Sie den folgenden Code

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 

Dieser dieser Code ersetzen statt

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 

Was meinen Code tut, ist eine Schleife durch jede Zelle jeder Zeile jeder Tabelle und den Tabellenindex aufnehmen, wenn der gesuchte Text gefunden. Es wird Sie warnen, wenn mehr als eine Übereinstimmung gefunden wird, aber die letzte gefundene Übereinstimmung wird verwendet.

+0

bekomme ich folgende Fehlermeldung: in dieser Zeile ‚Objekt diese Eigenschaft oder diese Methode nicht unterstützt‘: ‚Für x = 1 bis wdDoc.ActiveDocument.Tables.Count‘ – Gromdroid

+0

ersetzen wdDoc.ActiveDocument.Tables mit wdDoc.Tabellen – Shodan

+0

Das Skript funktioniert jetzt, aber ich fand heraus, dass es unmöglich ist, nach 'stackoverflow' zu suchen, weil es manchmal in der Tabelle ist und manchmal nicht. Weißt du, ob es möglich ist nur nach "name" zu suchen? Weil ich es versucht habe, aber jetzt findet es auch Tabellen mit "Firmenname" – Gromdroid

0

Erstes Problem, mehrere Dateien zu öffnen: Sie Application.FileDialog(), wie bei: https://msdn.microsoft.com/en-us/library/office/ff840210.aspx ich es in Publisher verwenden passiert ist, aber Auch hier gilt:

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 

Dies ist eine sehr einfache Schleife, die eine von Ihnen angegebene Liste abruft und anschließend eine Unterroutine (ProcessFilename) aufruft, um jede einzelne zu verarbeiten.