Word表格转Excel后提取列数据

liu-aguang · 发表于 2015-3-28 22:21

aman1516 发表于 2015-3-28 19:40
而我用来复制旧WORD到工作表的代码，对同样的文档却不会出现此问题，点解？

7/8楼问题:
原因是代码执行时会打开文档,默认是不可见的. 当代码执行错误时,强制退出VBA,但打开的文档并没有正常关闭,再次打开同一档就会出现"锁定"状态;即使关闭系统重启,在同一目录下也会遗留一个以"~"开头不可见的系统word文件. 这时运行代码,会打开该文件,从而导致后续代码执行出错.
所以在调试时最好设置:wd.visible=true;这样如果代码运行出错,但打开的word文档是可见的,可手动正常关闭文档,避免出现上面提到的问题.

liu-aguang · 发表于 2015-3-28 22:28

第一个附件:
由于word表格特点,在表格中存在编号为7所在行最后一个单元格被分为三个单元格的情形,导致出错.
第二个附件:
表格第一行的格式发生了改变.

aman1516 · 发表于 2015-3-28 23:06

liu-aguang 发表于 2015-3-28 22:28
第一个附件:
由于word表格特点,在表格中存在编号为7所在行最后一个单元格被分为三个单元格的情形,导致出错 ...

谢谢老师，
第二个问题对同格式的WORD修改代码可获取数据了；
第一个问题这种情况，请教下如何识别处理？

另外，如何修改代码可历遍多级子文件夹？

aman1516 · 发表于 2015-3-28 23:20

一个编号在不同列都可能会有对应多行的情况发生（相当于EXCEL的合并单元格），头痛......

liu-aguang · 发表于 2015-3-29 19:43

aman1516 发表于 2015-3-28 23:06
谢谢老师，
第二个问题对同格式的WORD修改代码可获取数据了；
第一个问题这种情况，请教下如何识别处理 ...

多行单元格容错代码:
1. 编号行,第四列以后出现多行单元格,可以正确读出所需要值;
2 .编号行,第二/三列出现多行单元格,则该编号行只能读出多行单元格的第一行值;
3. 上面第二个问题,由于项目名称以及表格格式差异较大,必须另写代码.
4. 关于遍历各子文件夹.论坛较多论述,自己去研究.(早晚得过这一关)

Sub test()
Dim arr(1 To 3000, 1 To 9), ar, fso, fp, n%, subp, f, i%, s$, k$, k1$, br, cr, m%
ar = [{1,3;2,3;3,3;1,5;2,5;3,5}]
Set fso = CreateObject("scripting.filesystemobject")
Set fp = fso.getfolder(ThisWorkbook.Path)
Set wd = CreateObject("word.application")
wd.Visible = True
n = 1
For Each subp In fp.subfolders
For Each f In subp.Files
If f Like "*.doc*" Then
With wd.documents.Open(f & "")
For i = 1 To UBound(ar)
arr(n, i) = Application.Clean(.tables(1).Cell(ar(i, 1), ar(i, 2)))
Next
On Error Resume Next
For Each tabe In .tables
m = 5
s = Application.Clean(tabe.Cell(m, 1))
Do While IsNumeric(s)
If Err = 0 Then
arr(n, 7) = s
k = tabe.Cell(m, 2): k = Left(k, Len(k) - 2)
k1 = tabe.Cell(m, 3): k1 = Left(k1, Len(k1) - 2)
br = Split(k, vbCr): cr = Split(k1, vbCr)
If UBound(br) = UBound(cr) Then
For i = 0 To UBound(br)
arr(n, 8) = br(i): arr(n, 9) = cr(i)
n = n + 1
Next
Else
arr(n, 8) = k: arr(n, 9) = k1: n = n + 1
End If
Else
Err.Clear
End If
m = m + 1
If tabe.Rows.Count = m Then Exit Do
s = Application.Clean(tabe.Cell(m, 1))
Loop
Next
On Error GoTo 0
.Close False
End With
End If
Next
Next
wd.Quit: Set fso = Nothing
Sheets("主文件").Range("a4").Resize(n, 9) = arr
End Sub

复制代码

aman1516 · 发表于 2015-3-29 23:15

谢谢老师这么仔细，我有一个想法：
能否通过 i=m to tabe.Rows.Count ，现加上 s1 = Application.Clean(tabe.Cell(m, 1)) , IsNumeric(s1)为条件，并设 s2= Application.Clean(tabe.Cell(m+1,1)) ，当s2=s1时（相当于判断Cell(m, 1))为合并单元格），再通过j=2 to tabe.Columns.Count 判断那一列是包含多个行，最后获取该编号一对多行的数据，
看上去很复杂，但似乎能解决表格不规范的问题.

aman1516 · 发表于 2015-3-30 21:35

本帖最后由 aman1516 于 2015-3-30 23:35 编辑

在WORD文档中，运行宏，查看表格是如何“定位”的：
Sub test()
Dim vt As Table, vCell As Cell, n As Long
n = 1
For Each vt In ThisDocument.Tables
      Debug.Print "第" & CStr(n) & "张表格"
      For Each vCell In vt.Range.Cells
         Debug.Print vCell.RowIndex, vCell.ColumnIndex, vCell.Range.Text
      Next
      n = n + 1
Next
End Sub
在本地立即窗中看到：
1）[表格定位]文档中的两个表能全部历遍，结果OK；
2）而[CJ202铝外壳]文档中的各个表格的信息却不齐全，结果NG，难怪执行代码时会出借了。
请教下老师是什么原因呢？

详见附件：

表格定位.rar (29.21 KB, 下载次数: 33)

		自动登录	找回密码
密码			免费注册

[求助] Word表格转Excel后提取列数据

点评

点评