Excel数据自动抽取设计与实现.doc

Excel文档数据自动抽取设计与实现中国人民革命军事博物馆 罗宁摘要：本文介绍了一个用VB6开发的抽取Excel文档内容的方法，利用这种方法可以抽取零散数据，并方便批量倒入数据库。对于数据的离线采集，批量导入非常实用。关键词：vb Excel 数据抽取一、 引言军事博物馆是个具有50年历史的老馆，从文物征集到整理入藏的过程中会形成很多纸质的档案和交接的帐目表格。这些档案和帐目过去基本是手写誊抄，不仅费时费力，还不利于查询利用和管理。计算机普及后，征集人员曾把手写文物档案改为Word文档，但在做交接帐目时还需手工录入，效率仍然不高。为了解决数据重复录入，耗时且出错率高的问题，笔者提出了用Excel工作簿取代Word文档的数据采集方案，并通过VB编程解决了数据批量抽取，形成各种交接帐目，并可将帐目中的数据导入文物帐目数据库，以利于进一步的管理。此方案应用后能很好地适应这种数据分散采集，统一处理的工作模式，提高了工作流程的自动化水平和工作效率。现以“征集帐目生成程序”为例介绍这一方法。二、实施方案分析1、需求分析文物管理要求一物一档，军博使用的文物档案是按国家文物局的标准定制的含文物名称、数量、年代、质地、尺寸重量、捐赠者、流传经历等几十个著录项目共7页的表格。笔者按此格式制成了含7个工作表的Excel工作簿作为文物档案模板。每份档案以“入馆凭证号”命名。工作中需要每隔一段时间从一批单个的Excel档案工作簿中自动抽取出入馆凭证号、文物名称、数量和来源项目的数据，填入一个新的Excel列表，自动生成征集帐目，以满足建帐要求。文物档案工作簿的第二页表sheet2中，有名称、原编号、时代、作者/物主、制作时间、数量、质地、色泽、用途、作者小传、来源（含发掘地址、拨交单位、采集地区、交换单位、捐赠者姓名、捐赠者地址、经办人）、尺寸重量、入馆日期、入馆凭证号、附属物、形状内容描述等多个著录项。如下图所示：需要抽取的数据项为入馆凭证号、名称、数量、来源（由拨交单位、捐赠者地址、姓名等项目组合而成）四项，形成新的征集帐目表单如下：入馆凭证号名称数量来源2009/001名称一1来源一2009/002名称二1来源二每份档案抽取的数据形成新表的一行数据。这样，一批需要交接的文物档案可以统一处理形成一个征集帐目表，用于统计、归档和交接。需抽取的数据都填写在原Excel档案工作簿中的固定单元格内，用编程的方法可以实现定位抽取并循环填入新Excel工作簿“征集帐目表”的相应的单元格内。两表数据对应单元格如下表所示：数据项对应原工作表对应原表单元格对应新工作表对应新表单元格入馆凭证号Sheet2H21结果A（n+1）名称Sheet2C1结果B（n+1）数量Sheet2H3结果C（n+1）来源（拨交单位）Sheet2D12结果D（n+1）来源（捐赠者地址）Sheet2E15结果D（n+1）来源（捐赠者姓名）Sheet2E14结果D（n+1） 2、功能分析 程序界面如下图所示：表单上半部分的一组DirveListBox、DirListBox 和FileListBox控件用于选择存放需处理的成批文物档案工作簿所在路径。选定后FileListBox中显示出整批的文物档案工作簿名称。表单下半部分的一组DirveListBox、DirListBox 和FileListBox控件用于选择存放新的“征集帐表单.xls”文件所在路径，在选定此文件后，“处理数据”按钮显示为可用，点击后即开始逐个抽取档案工作簿中固定单元格内的内容，按需组合后，逐行填入征集帐表单，自动生成帐目内容。处理每个档案文件时，档案文件名高亮显示，处理完成后提示处理所用时间。一般一分钟内可以处理20件文档。数据抽取后生成帐目文档如下图所示：二、 程序实现1、流程图：2、核心代码：在VB6.0环境中，建立一个标准的EXE工程，在“工程”菜单下选择“引用”项，然后加入Microsoft Excel 11.0 Object Library，用于加载与Excel交互代码的类库支持。此程序主要实现一个循环和一个数据抽取填入。数据抽取和填入采用编写与Excel交互的类代码来实现，在循环里调用这个类的实例实现文档的批量处理。建一个与Excel交互的类模块cls_excel 代码如下：Public Function C_Excel(Pdir As String, filename As String, pos As String, MidFileName As String) 变量说明：Pdir 为Excel文件所在路径，filename为需抽取数据的原工作簿名，pos为正处理的文件在文件列表中的位置值加1即新表中需填数据的行号，MidFileName为要填入的“征集帐表单.xls”所在路径。Dim ExcelObj1 As Excel.Application 定义一个Excel对象变量用于抽取文档对象处理Dim ExcelObj2 As Excel.Application 定义第二个Excel对象变量用于征集帐表单处理Dim path1 As StringDim path2 As StringOn Error GoTo ERR_handle Screen.MousePointer = vbHourglass 改变鼠标形状为沙漏状态 Set ExcelObj1 = CreateObject(Excel.Application) 创建新对象 Set ExcelObj2 = CreateObject(Excel.Application) ChDir Pdir 定位要抽取的Excel工作簿所在目录 path1 = Pdir + + filename 路径1为需抽取的档案工作簿的路径 path2 = MidFileName 路径2为空“征集帐表单.xls”所在的路径 ExcelObj1.Workbooks.Open (path1) 打开路径1的Excel文物档案工作簿 ExcelObj2.Workbooks.Open (path2) 打开“征集帐表单.xls”文件 ExcelObj1.Sheets(Sheet2).Select 选定文物档案工作簿的“sheet2”工作表 ExcelObj1.Range(H21).Select 定位“入馆凭证号”数据项所在单元格 ExcelObj2.Sheets(结果).Select 定位征集帐表单.xls的“结果”工作表 ExcelObj2.Range(A + pos).Select 在征集帐表单.xls第一列的第pos行位置填写数据 ExcelObj2.ActiveCell.FormulaR1C1 = LTrim(RTrim(ExcelObj1.ActiveCell.Text) ExcelObj2.ActiveWorkbook.Save 保存数据 以下同上处理名称、实际数量、来源（由拨交单位和捐赠者组成）项此处省略处理名称和数量项目的代码 来源一栏的处理（由拨交单位和捐赠者地址姓名等项组合而成） ExcelObj1.Sheets(Sheet2).Select ExcelObj1.Range(D12).Select 拨交单位 Dim source As String If ExcelObj1.ActiveCell.Text Then source = 拨交单位： + LTrim(RTrim(ExcelObj1.ActiveCell.Text) End If ExcelObj1.Sheets(Sheet2).Select ExcelObj1.Range(E15).Select 定位捐赠者地址并处理数据 If ExcelObj1.ActiveCell.Text Then source = source + /捐赠者： + LTrim(RTrim(ExcelObj1.ActiveCell.Text) End If ExcelObj2.Sheets(结果).Select ExcelObj1.Range(E14).Select 定位捐赠者并处理数据 If ExcelObj1.ActiveCell.Text Then source = source + LTrim(RTrim(ExcelObj1.ActiveCell.Text) End If ExcelObj2.Range(D + pos).Select 填写来源一项 ExcelObj2.ActiveCell.FormulaR1C1 = source source为拨交单位和捐赠者的组合 ExcelObj2.ActiveWorkbook.Save ExcelObj1.ActiveWindow.Close ExcelObj2.ActiveWindow.Close Set ExcelObj1 = Nothing 释放ExcelObj对象 Set ExcelObj2 = Nothing DONE: Screen.MousePointer = vbDefault 恢复鼠标形状为正常 Exit FunctionERR_handle: MsgBox (请确认excel运行正常。) ExcelObj1.Application.Quit ExcelObj2.Application.Quit Resume DONEEnd Function在窗体中处理数据按钮的click事件里的循环代码中调用以上所建类的实例即可，代码省略。3、关键技术此代码段中的关键技术主要是对Excel工作簿的系列操作。首先需新建Excel.Application对象excelobj,用ExcelObj1.Workbooks.Open (path1)命令来打开一个Excel的工作簿，参数path1为工作簿路径。ExcelObj1.Sheets(Sheet2).Select 命令用来选定“Sheet2”这样的特定的工作表。ExcelObj1.Range(H21).Select命令用来定位特定的单元格。用同样的一组命令定位另一Excel工作表的需填入数据的单元格“结果”工作表中第一列的第pos行，ExcelObj2.Range(A + pos).Select。ExcelObj2.ActiveCell.FormulaR1C1 = LTrim(RTrim(ExcelObj1.ActiveCell.Text)是将第一个Excel对象的活动单元格内的内容去空格后赋与第二个Excel对象的活动单元格中。这就完成了数据的抽取和填入。ExcelObj2.ActiveWorkbook.Save命令用来保存活动工作簿的内容。四、结束语本程序主要使用了VB和Excel交互的技术从多个已定义的Excel工作簿中抽取固定单元格中的内容，填写到一个新的Excel工作簿中，自动形成列表。形成的Excel新工作簿可利用Excel的功能自由排版打印归档，也可以作为导入数据库的源文件。这对于数据分散采集，集中处理是非常实用的方法。这种方法除了应用于文物档案管理，还可以应用于人员管理、固定资产管理、车辆管理等很多领