将word中表格批量导入到Excel
将word中表格批量导⼊到Excel
出乎意料的高兴如果是⼀个word中的,复制粘贴。
如果是多个word中的,需要写个代码(如下),或者在⽹上⼀下相关的⼯具。
此⽅法适⽤于多个word⽂档⾥⾯的所有表格:
1、将多个含有表格的word⽂档放⼊⼀个⽬录;
2、在该⽬录中新建⼀个空的;
3、在中运⾏以下宏命令,即可。
Sub WordTabletoExcel()
Dim WordApp As Object, DOC, mTable, Fn$, Str$
On Error Resume Next    '设置容错代码
CreateObject("wscript.shell").Run " /c dir """ & ThisWorkbook.Path & "\*.doc"" /s/b>""" & ThisWorkbook.Path & "\""", False, True    '取得指定⽬录下的word⽂档清单
Set WordApp = CreateObject("word.application")  '创建word程序项⽬(⽤于操作word⽂档)
WordApp.Visible = True  '设定word程序项⽬可见
Open ThisWorkbook.Path & "\" For Input As #1    '打开清单⽂件并读取内容
While Not EOF(1)    '循环读取清单⽂件各⾏内容
租房子要注意什么
Input #1, Str  '输⼊⼀⾏⽂本到变量str中
If Trim(Str) <> "" Then '如果⽂本有效则
报考护师的条件Set DOC = WordApp.Documents.Open(Trim(Str)) '利⽤word程序项⽬打开对应的word⽂档
With DOC
难忘的小学生活作文For Each mTable In .Tables  '循环⽂档中的各个表格
If Mid(mTable.Cell(1, 1).Range.Text, 1, 4) = "⽔库名称"  and  Mid(mTable.Cell(1, 1).Range.Text, 1, 4) <> "⽔库名称" Then      '判断第⼀⾏第⼀列的名称
'整个表格复制
WordApp.Activate    '激活word程序,使之窗体前置
mTable.Range.Copy  '复制表格区域
With Windows(1)    '激活excel程序窗体,使之前置
挽回爱情的话.Activate
With ThisWorkbook.ActiveSheet  '选中当前使⽤区A列下⾯的第⼀个单元格,并粘贴复制的word中的表格数据
.Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row + 1, 1).Select
.Paste
End With
End With
'获取某个关键字值
For Each MyRng In MyTable.Range.Cells
With MyRng.Range.Find
如何获得Q币
.Text = "关键字"
.Execute
If .Found Then
Sheets(1).[b65536].End(3).Offset(1) = Replace(MyRng.Next.Range, Chr(7), "")
End If
End With
Next MyRng
End If
Next mTable
.Close False    '关闭word⽂档
End With
End If
Wend
Close #1    '关闭清单⽂件
If Dir(ThisWorkbook.Path & "\") <> "" Then Kill ThisWorkbook.Path & "\"    '删除清单⽂件
WordApp.Quit    'word程序项⽬关闭
Set DOC = Nothing  '清空对应项⽬变量
Set WordApp = Nothing End Sub

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。