从几千张word版的《准考证》中提取参加考核人员的信息。

王海海彭霞霞

各路高手，用什么方法从几千张word版本的《准考证》中提取参加考核人员的信息。看附件就懂什么意思了。求高手帮忙！

zmj9151

准考证格式固定，vba编码，循环每一个表格，提取数据，程序做很快的

changhong8

几千张准考证是在一个Word文件内还是每个文件一个

shizhe80

首先你的思路不正确，为什么不把几千个考生的信息录到一张EXCEL表格里？这样要查找不是更方便吗？

changhong8

Sub 准考证汇总()
Dim wd As Word.Application
Dim odoc As Object
Dim arr(1 To 10000, 1 To 12)
Application.ScreenUpdating = False
t = Timer
Set wd = CreateObject("word.application")
mypath = ThisWorkbook.Path & "\"
fn = Dir(mypath & "*.do*")
Do While fn <> ""
    Set odoc = wd.Documents.Open(mypath & fn)
    With odoc
        For Each tablex In .Tables
            If tablex.Rows.Count = 11 And tablex.Columns.Count = 6 Then
                Num = Num + 1
                With tablex
                    arr(Num, 1) = .Cell(2, 2).Range
                    For Each k In Array(3, 4, 5, 6, 7)
                        arr(Num, k) = .Cell(k, 2).Range
                    Next
                    For Each k In Array(9, 10, 11, 12)
                        arr(Num, k) = .Cell(k - 1, 2).Range
                    Next
                    arr(Num, 2) = .Cell(2, 4).Range
                    arr(Num, 8) = .Cell(7, 4).Range
                End With
            End If
        Next
        .Close
    End With
    fn = Dir()
Loop
wd.Quit
For i = 1 To Num
    For j = 1 To UBound(arr, 2)
        arr(i, j) = Left(arr(i, j), Len(arr(i, j)) - 1)
    Next
Next
Set wd = Nothing
Set odoc = Nothing
Sheets(1).Activate
Rows("2:10000").Clear
Range("a2").Resize(Num, 12) = arr
With Range("a1").CurrentRegion
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Borders.LineStyle = 1
End With
MsgBox Timer - t
Application.ScreenUpdating = True
End Sub

王海海彭霞霞

changhong8 发表于 2018-10-17 21:40
几千张准考证是在一个Word文件内还是每个文件一个

所有的准考证都在一个文档里面

Moneky

可以试试我的工具   doc2xls

王海海彭霞霞

zmj9151 发表于 2018-10-17 21:07
准考证格式固定，vba编码，循环每一个表格，提取数据，程序做很快的

求代码！！！

王海海彭霞霞

changhong8老师：
问题如下图

蓝桥玄霜

代码放在Excel文件里面。