如何把多个word文件的表格汇总到一个表格里

1478525

jiangxiaoyun 发表于 2024-7-29 18:49
word vba区域已经有很多代码了，搜搜就能拿来用

我咋没找到word vba区域，可以给个链接吗 谢谢

gwjkkkkk

ct阿田 发表于 2024-7-31 22:03
大哥感谢你的大恩大德，非常符合，如果还能把其他几行也匹配上就完美了（外出务工省(市)和务工开始 ...

改一句：
br = Array(2, 4, 6, 8, 10, 12, 16, 18, 20)

413191246se

1478525 发表于 2024-7-31 22:05
我咋没找到word vba区域，可以给个链接吗 谢谢

上面导航区《VBA开发》

A00喻老师

ct阿田 发表于 2024-7-31 22:03
大哥感谢你的大恩大德，非常符合，如果还能把其他几行也匹配上就完美了（外出务工省(市)和务工开始 ...

excel宏里面2，4，6那个往后加数就可以看见了

znppnz

gwjkkkkk 发表于 2024-7-30 21:42
Option Explicit
Sub test()
    Dim ar, br, j&, r&, wdApp As Object, strFileName$, strPath$

大神，我蒙着改了一下，测试是对的。现在要EXCEL第一行留着写标题，提取的数据第2行写起，该怎么改代码？还有，如果WORD里有两个表格，要提取第2个表格的，怎么改？
Option Explicit
'提取word表格中指定单元格数据到表格，只要word表格是同一模板
Sub test()
    Dim ar, br, j&, r&, wdApp As Object, strFileName$, strPath$
   
    Application.ScreenUpdating = False
   
    ReDim ar(1 To 10 ^ 3, 1 To 10) '一共要提取多少处，就把10改成几
    br = Array(1, 3, 5, 7, 9, 11, 13, 15, 17, 19) '要根提取的从左到右，再第2行，……，是第几格，就依次写几，用英文逗号隔开
   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err <> 0 Then
        Set wdApp = CreateObject("Word.Application")
        'wdApp.Visible = True
    End If
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.docx") '如果是doc文件，将*.docx改成*.doc，全部放本EXCEL放在同一文件夹下
    Do Until strFileName = ""
        With wdApp.documents.Open(strPath & strFileName)
            With .Tables(1)
                r = r + 1
                For j = 0 To UBound(br)
                    ar(r, j + 1) = Left(.Range.Cells(br(j)).Range.Text, Len(.Range.Cells(br(j)).Range.Text) - 1)
                Next j
            End With
            .Close False
        End With
        strFileName = Dir
    Loop
        
    Cells.Clear
    If r Then [A1].Resize(r, UBound(ar, 2)) = ar
   
    If Err <> 0 Then wdApp.Quit
    Set wdApp = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub