提取并修改Word表格

李桥贵

麻烦老师一下
在不打开《交来Word表格》文件夹Word，先提取放在《交来Word表格》文件夹的教师交来Word表格的内容到Excel表（提取和修改表）中，核对提取的信息，有错误的在修改表中修改信息，然后填回到Word表格中并保存到《修改后Word表格》文件夹。
提取并修改事业单位工作人员奖励审批表.zip (40.01 KB, 下载次数: 19)

2024-1-2 22:24 上传

点击文件名下载附件

liulang0808

关于word文档处理的案例。论坛里还是很多的，可以参考
楼主这个要求不打开word，就有点麻烦了。

李桥贵

liulang0808 发表于 2024-1-3 07:39
关于word文档处理的案例。论坛里还是很多的，可以参考
楼主这个要求不打开word，就有点麻烦了。

还是要麻烦老师一下
先打开《交来Word表格》文件夹Word，先提取放在《交来Word表格》文件夹的教师交来Word表格的内容到Excel表（提取和修改表）中，核对提取的信息，有错误的在修改表中修改信息，然后填回到Word表格中并保存到《修改后Word表格》文件夹。
提取并修改事业单位工作人员奖励审批表.zip (100.3 KB, 下载次数: 7)

2024-4-13 23:13 上传

点击文件名下载附件

李桥贵

李桥贵 发表于 2024-4-13 23:14
还是要麻烦老师一下
先打开《交来Word表格》文件夹Word，先提取放在《交来Word表格》文件夹的教师交来 ...

还是要麻烦老师一下
先打开《交来Word表格》文件夹Word，先提取放在《交来Word表格》文件夹的教师交来Word表格的内容到Excel表（提取和修改表）中，核对提取的信息，有错误的在修改表中修改信息，然后填回到Word表格中并保存到《修改后Word表格》文件夹。
提取并修改事业单位工作人员奖励审批表.zip (100.3 KB, 下载次数: 17)

2024-4-14 13:56 上传

点击文件名下载附件

gwjkkkkk

李桥贵 发表于 2024-4-14 13:55
还是要麻烦老师一下
先打开《交来Word表格》文件夹Word，先提取放在《交来Word表格》文件夹的教师交来Wo ...

word单元格数据不规范，提起来比较麻烦。。。，如果一对一的话可能好办一些。。。

xlqsxl

你可以考虑下我这个工具：https://club.excelhome.net/thread-1688756-1-1.html

可以很完美的解决你的需求，这是我用工具给你抓取的结果：

这是软件的参数设置界面：

蓝桥玄霜

提取的例子：

李桥贵

蓝桥玄霜 发表于 2024-4-15 15:16
提取的例子：

老师，您好

      再麻烦您一下，帮忙写个修改的代码，因为在工作中，需要在很短时间内先核对教师交来的表格，再对错误的表格进行修改主，或者是对填写不完整的表格进行完善，由于时间紧，先一个个打开核对再去修改比较费时间，就想用就这个方式进行核对修改。再请老师您辛苦一下，在百忙之中抽点时间，帮我再编写个修改的代码。谢谢！

liulang0808

Sub 按钮1_Click()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ThisWorkbook.Path & "\"
        .Title = "请选择对应文件夹"
        If .Show Then pth = .SelectedItems(1) Else Exit Sub '
    End With
    Set wdapp = CreateObject("word.application")
    Set fso = CreateObject("scripting.filesystemobject")
    wdapp.Visible = True
    Set ff = fso.getfolder(pth).Files
    ReDim arr(1 To ff.Count, 1 To 24)
    brr = Array(3, 1, 2, 4, 1, 4, 5, 1, 6, 6, 2, 2, 7, 1, 4, 8, 2, 6, 9, 3, 2, 10, 3, 4, 11, 4, 2, 12, 4, 4, 13, 5, 2, 14, 6, 2, 15, 6, 4, 16, 7, 2, 17, 8, 2, 18, 9, 2, 19, 10, 2)
   
    Application.ScreenUpdating = False
    r = 0
    For Each f In ff
        With wdapp.documents.Open(f & "")
            s = Format(WorksheetFunction.Clean(Split(.Paragraphs(2).Range.Text, "：")(1)), "yyyy-mm-dd")
            r = r + 1
            arr(r, 1) = r
            arr(r, 2) = s
            For j = 0 To UBound(brr) Step 3
                arr(r, brr(j)) = "'" & WorksheetFunction.Clean(.tables(1).cell(brr(j + 1), brr(j + 2)).Range.Text)
            Next j
            crr = Split(Replace(WorksheetFunction.Clean(.tables(1).cell(11, 2).Range.Text), " ", ""), "盖章")
            arr(r, 20) = crr(0)
            arr(r, 21) = crr(UBound(crr))
            crr = Split(Replace(WorksheetFunction.Clean(.tables(1).cell(12, 2).Range.Text), " ", ""), "盖章")
            arr(r, 22) = Trim(crr(0))
            arr(r, 23) = Trim(crr(UBound(crr)))
            .Close False
        End With
    Next f
    wdapp.Quit
    rx = Cells(Rows.Count, 1).End(3).Row
    Cells(rx, 1).Offset(2).Resize(r, UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub

liulang0808

修改的供参考