高难度提取！！word提取到Excel表格里，

zqing513

有没有哪位大神帮帮我 ！！

很多类似附件的word文档 格式都一样 想提取数据到Excel里面，类似我截图那样！不知道用VBA怎么实现？

sunshuangzhong

高难度吗高难度吗高难度吗高难度吗？

taller

Lovertdos

一点也不难，就是速度太慢，三、四秒钟才能提取一个

3190496160

Sub 批量提取()
Dim i As Integer, n As Integer
Dim arr()
Application.ScreenUpdating = False
Dim WordApp As Object
Set WordApp = CreateObject("Word.Application")   '新建Word对象
WordApp.Visible = True
Dim WordD As Object
ReDim arr(1 To 10000, 1 To 9)
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.doc*")
Do While f <> ""
    Set WordD = WordApp.Documents.Open(lj & f)
    With WordD.tables(1)
        For i = 11 To 14
            zd = Replace(.Cell(i, 3).Range.Text, Chr(13) & Chr(7), "")
            If zd <> "" Then
                n = n + 1
                arr(n, 1) = Replace(.Cell(2, 2).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 2) = Replace(.Cell(6, 2).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 3) = Replace(.Cell(1, 4).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 4) = Replace(.Cell(i, 3).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 5) = Replace(.Cell(i, 4).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 6) = Replace(.Cell(i, 5).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 7) = Replace(.Cell(3, 4).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 8) = Replace(.Cell(5, 4).Range.Text, Chr(13) & Chr(7), "")
                arr(n, 9) = Replace(.Cell(7, 2).Range.Text, Chr(13) & Chr(7), "")
           End If
        Next i
    End With
    WordD.Close False
f = Dir
Loop
Set WordD = Nothing
WordApp.Quit
[a1].CurrentRegion.Offset(1) = Empty
Range("a2").Resize(n, 9) = arr
Application.ScreenUpdating = True
MsgBox "完成"
End Sub

3190496160

新桌面.rar (64.63 KB, 下载次数: 21)

2024-3-16 09:01 上传

点击文件名下载附件

lizhipei78

到我的主题帖子里面有通用的提取代码，简单易举，不求别人

zqing513

谢谢各位大佬  我初学者

zqing513

3190496160 发表于 2024-3-16 09:01

大佬 你这个附件我看了 你提取配件 数量 编码 这三种数据 仅仅限制11-14  有的word是1行 有的的9行 你这个执行不了 改了11 to 40 执行后错误

zqing513

3190496160 发表于 2024-3-16 09:01

假设word有个别不存在14个table  有些超过14个table 那怎么调试？