逐行读取WORD文档数据

时　间:2017-11-22 22:33:48
作　者:林岚   ID：3651  城市：中卫
摘　要:有些WORD文档中数据，不是以表格形式显示，但数据又类似表格数据，仅是存在方式以逗号或者制表符或者空格等在行中进行数据分隔的形式表现为表格中的行，而这些行在文档中实际就是一个段落。
此类WORD文档我们称之为类表格数据。经常采用逐行（段）读取的方法完成数据读取。
正　文:

点击下载此附件

【问题】
有些WORD文档中数据，不是以表格形式显示，但数据又类似表格数据，仅是存在方式以逗号或者制表符或者空格等在行中进行数据分隔的形式表现为表格中的行，而这些行在文档中实际就是一个段落。
此类WORD文档我们称之为类表格数据。经常采用逐行（段）读取的方法完成数据读取。
【示例1】
与被操作工作簿保存位置相同的文件夹“WORD表格”中的文档“数据清单.doc”中的类似表格的数据，如下所示：
文昌9-1-1井测井二次解释成果表


 序号      井   段      厚度   泥质   孔隙   含水     渗透   等效烃   结论
                               含量    度   饱和度     率     厚度
              m           m      %      %      %       md       m
=================================================================
   1   3230.8  3232.0    1.2   11.0   12.2   70.0      2.1    0.044   差气层　
   2   3232.0  3232.7    0.7   15.5    8.5                            干层　　
   3   3232.7  3235.2    2.5    7.6   11.1   70.0      0.9    0.083   差气层　
   4   3236.6  3238.4    1.8    2.7   20.2   31.4    684.9    0.249   气层　　
   5   3238.4  3239.3    0.9    4.3   12.6   69.5      2.8    0.035   气层　　


要求把这些类表格的数据写入被操作的EXCEL当前工作表A1起始的单元格区域。工作表第一行是标题行，后续是以“序号”显示的各数据行。
【代码】
Sub按段落读取WORD数据() 
Application.ScreenUpdating = False
开始时间 = Timer '秒
'1.清除表中标题行以下数据
dqH = ActiveSheet.UsedRange.Rows.Count'已经使用的数据行数
dqL = ActiveSheet.UsedRange.Columns.Count'已经使用的数据列数
If dqH >= 2 Then ActiveSheet.Range(Cells(2, 1).Address & " : " & Cells(dqH, dqL).Address).ClearContents'清除第2行及以下的数据内容
'2.打开WORD文档并计算行数
MyFile = ThisWorkbook.Path & "\WORD表格\数据清单.doc"
Set wd = CreateObject(MyFile)
段落数 = wd.Paragraphs.Count
'3.逐行读取WORD文档数据数据把不是标题行数据写入当前工作表
每次读行数 = 1
Excel行号 = 2
For 读段落 = 1 To 段落数
    段落文本 = wd.Paragraphs(读段落).Range.Text
    左6字符 = Replace(Left(段落文本, 6), " ", "")'提取段落文本左边6个字符并去掉空格
    If Val(左6字符) > 0 Then
       Range("A" & Excel行号) = 段落文本
       Excel行号 = Excel行号 + 1
    End If
Next
wd.Close
Set wd = Nothing
'4.把写入当前工作表A列数据按指定宽度分列
With ActiveSheet
     hs = .UsedRange.Rows.Count
     .Range("A2:A" & hs).TextToColumns Destination:=Range("A2"), DataType:=xlFixedWidth'分列
     .Cells.EntireColumn.AutoFit '自动调整列宽
End With
MsgBox Chr(10) & "成功按段落读取文件 " & Dir(MyFile) & " 中数据到当前工作表" _
       & Chr(10) & Chr(10) & "读取数据共用 " & Timer - 开始时间 & " 秒", , "按段落读取WORD数据"
Application.ScreenUpdating = False
End Sub
思路提示：
计算段落总数——段落数 = wd.Paragraphs.Count
读取段落文本——段落文本 = wd.Paragraphs(读段落).Range.Text
判断段落文本左边6个字符去掉空格后是否是序号数，是则写入EXCEL工作表A列的对应行。
最后把写入EXCEL工作表A列的数据按照指定宽度进行分列。
【示例2】
与被操作工作簿保存位置相同的文件夹“WORD表格”中的文档“体检结果.doc”中数据如下所示：
章建鑫,34,男,,,三角站,
叶明志,17,男,,,三角站,
顾雅芬,52,女,330622195712260063,82162759,三角站,血脂异常;
张炳良,61,男,330622194801170014,82162383,三角站,糖尿病;
阮雅芬,56,女,330622195309260020,82161062,三角站,糖尿病前期;
郦珠花,58,女,330622195109100022,82162847,三角站,
要求按段落读取到被操作工作簿当前工作表A2起始的单元格区域。工作表第一行是根据WORD文档数据显示的属性手工录入的列标题。
从给出的WORD文档数据仔细观察可以看出：
文档中的一行是一个段落，每行中的数据用逗号分隔，共有7个数据项，依次是姓名、年龄、性别、身份证号码、联系电话、检查地点、检查结果。
所以把这类似表格的WORD数据写入EXCEL中，可以事先拟定一个标题行，然后把WORD数据按段落写入工作表第二行开始的单元格区域。
【代码】
Sub 把用逗号分隔的段落数据写入当前工作表()
Application.ScreenUpdating = False
开始时间 = Timer '秒
'1.清除表中标题行以下数据
dqH = ActiveSheet.UsedRange.Rows.Count
dqL = ActiveSheet.UsedRange.Columns.Count
If dqH >= 2 Then ActiveSheet.Range(Cells(2, 1).Address & " : " & Cells(dqH, dqL).Address).ClearContents
'2.打开WORD文档并计算段落数
MyFile = ThisWorkbook.Path & "\WORD表格\体检结果.doc"
Set wd = CreateObject(MyFile)
段落数 = wd.Paragraphs.Count
'3.逐段读取WORD文档数据写入当前工作表
Excel行号 = 2
For 读段落 = 1 To 段落数
    段落文本 = Split(wd.Paragraphs(读段落).Range.Text, ",") '把用半角逗号分隔的字符串段落写入数组
    数据项 = UBound(段落文本)
    For 读项 = 0 To 数据项
        If 读项 = 3 Then '写入身份证号码
           ActiveSheet.Cells(Excel行号, 读项 + 1).NumberFormatLocal = "@"
           ActiveSheet.Cells(Excel行号, 读项 + 1) = 段落文本(读项)
        ElseIf 读项 <> 3 Then '写入其他数据项
           ActiveSheet.Cells(Excel行号, 读项 + 1) = 段落文本(读项)
        End If
    Next
    Excel行号 = Excel行号 + 1 '在工作表中写入数据行数叠加1
Next
wd.Close
Set wd = Nothing
ActiveSheet.Cells.EntireColumn.AutoFit '自动调整列宽
'4.信息提示
MsgBox Chr(10) & "成功读取文件 " & Dir(MyFile) & " 中数据到当前工作表" _
       & Chr(10) & Chr(10) & "读取数据共用 " & Timer - 开始时间 & " 秒", , "读取WORD数据"
Application.ScreenUpdating = False

End Sub

注   意：
WORD文档中的行数据用半角逗号分隔，因此读取的行(段落)数据可以写入数组——段落文本 = Split(wd.Paragraphs(读段落).Range.Text, ",")，再逐个读取数组中的各个数据写入工作表对应行的对应单元格。
文档各段落数据中有身份证号码，所以要求在写入工作表时要对应设置身份证号码列是文本格式，否则身份证号码不能完全显示。

Access软件网QQ交流群 (群号:54525238) 　　　　　　Access源码网店