求助老师帮忙

cainiao1231

老师，我这有200多个WORD数据，WORD里的表格格式不一样，想通过关键字合计汇总到一个EXCEL中，该如何写，谢谢老师。
原WORD格式

xyxcc177

以公司名称命名文件名就好办

cainiao1231

xyxcc177 发表于 2018-8-2 06:25
以公司名称命名文件名就好办

是以公司名称命名的，怎么做呢，老师

cainiao1231

坐等老师解决

xyxcc177

cainiao1231 发表于 2018-8-2 08:06
坐等老师解决

老坐等能行吗？

xyxcc177

程序在word中
Sub test()

Dim ph As Paragraph
Dim gsName, je As String
Dim r, c As Integer
Dim path As String
Dim tb As Word.Table
Dim wdFile As String

Dim doc As Document
path = ThisDocument.path
wdFile = Dir(path & "\*.docx")
Dim arr(200, 2)
Dim i As Integer
i = 0

Do While wdFile <> ""
Set doc = Application.Documents.Open(path & "\" & wdFile)

For Each ph In doc.Paragraphs
gsName = ph.Range.Text             '取出公司名称
If Len(gsName) > 1 Then Exit For
Next
gsName = getText(gsName)

Set tb = doc.Tables(1)
r = tb.Rows.Count: c = tb.Columns.Count
je = getText(tb.Cell(r, c - 1).Range.Text) '取出合计
   arr(i, 0) = gsName: arr(i, 1) = je
  i = i + 1
  doc.Close
  wdFile = Dir

Loop

Dim excel As Object
Set excel = CreateObject("excel.application")
Dim book As Object
Set book = excel.workbooks.Open(path & "\结果.xlsx")
book.worksheets(1).Range("a2").Resize(200, 2).Value = arr
excel.Visible = True
  

End Sub
Function getText(ByVal txt As String) As String
getText = Mid(txt, 1, Len(txt) - 1)

End Function

cainiao1231

xyxcc177 发表于 2018-8-2 09:35
程序在word中
Sub test()

老师，能不能直接用合计作为关键字，提取后面那个数值。主要由于有些WORD有几个表格的，再次麻烦老师了

xyxcc177

cainiao1231 发表于 2018-8-2 09:45
老师，能不能直接用合计作为关键字，提取后面那个数值。主要由于有些WORD有几个表格的，再次麻烦老师了

Sub test()

Dim ph As Paragraph
Dim gsName, je As String
Dim r, c As Integer
Dim path As String
Dim tb As Word.Table
Dim wdFile As String
Dim HJ As Double

Dim doc As Document
path = ThisDocument.path
wdFile = Dir(path & "\*.docx")
Dim arr(200, 2)
Dim i As Integer
i = 0

Do While wdFile <> ""
Set doc = Application.Documents.Open(path & "\" & wdFile)

   For Each ph In doc.Paragraphs
     gsName = ph.Range.Text             '取出公司名称
     If Len(gsName) > 1 Then Exit For
   Next
   gsName = getText(gsName)
   HJ = 0
    For Each tb In doc.Tables
     r = tb.Rows.Count: c = tb.Columns.Count
     je = getText(tb.Cell(r, c - 1).Range.Text) '取出合计
     HJ = HJ + Val(je)
    Next
   arr(i, 0) = gsName: arr(i, 1) = HJ
  i = i + 1
  doc.Close
  wdFile = Dir

Loop

Dim excel As Object
Set excel = CreateObject("excel.application")
Dim book As Object
Set book = excel.workbooks.Open(path & "\结果.xlsx")
book.worksheets(1).Range("a2").Resize(200, 2).Value = arr
excel.Visible = True
  

End Sub

cainiao1231

xyxcc177 发表于 2018-8-2 10:01
Sub test()

Dim ph As Paragraph

老师，先谢谢了，但有些WORD好几个表格，但合计就只有一个，我只想取合计的数值，您写的对一个表的没问题。

xyxcc177

你在胡说，你有1000个表格都可以提取的，你一开始不把所有的问题都摆出来，你这是玩呢