Word表格数据提取工具
主要功能
该代码专为Excel设计，用于从Word文档中批量提取指定表格单元格的数据，并将其结构化输出到Excel工作表中。
核心功能点
- 自定义单元格提取：通过配置数组指定需提取的单元格位置（行、列）及对应表头名称，支持最多5个单元格的灵活配置。（可自定义单位格数量）
- 多表格批量处理：自动遍历Word文档中的所有表格，逐表提取目标单元格数据。
- 自动化表头生成：根据配置自动在Excel中生成表头，并应用格式化（加粗、灰色背景）。
- 错误处理机制：检测Word文档打开状态、表格是否存在、单元格越界等异常情况，提供友好提示。
- 交互式文件选择：通过对话框选择Word文档，避免硬编码路径依赖。
适用场景
- 从标准化Word测试用例文档中提取关键字段（如用例标识、测试类型）。
- 批量处理包含多表格的Word报告，汇总特定数据到Excel进行分析。
- 需要将Word表格中分散的单元格数据重新组织为结构化表格的场景。
输出示例
提取的数据按表格顺序排列，每行对应一个Word表格，列对应配置的单元格内容。表头自动匹配配置名称，列宽自适应调整。
 |  |
视频演示：
效果演示
代码展示：
Attribute VB_Name = "TabEx"
Sub word2els()Dim wdApp As ObjectDim docPath As VariantDim targetSheetName As StringDim targetSheet As WorksheetDim n As IntegerDim excel_line_no As IntegerDim i As Integer, j As IntegerDim cellValue As String' --------------------自定义设置区--------------------targetSheetName = "Sheet1" ' 目标工作表名称' 定义要提取的单元格数组，可根据需要添加或删除' 格式: (行, 列, 表头名称)Dim cellsToExtract(1 To 5) As Variant ' 最多可提取5个单元格，可修改数组大小' 示例配置 - 可根据需要增删或修改cellsToExtract(1) = Array(2, 2, "序号1") ' (行, 列, 表头)cellsToExtract(2) = Array(3, 5, "用例标识") ' (行, 列, 表头)cellsToExtract(3) = Array(3, 7, "测试类型") ' (行, 列, 表头)' 取消下面的注释来添加更多单元格cellsToExtract(4) = Array(1, 2, "测试结果") ' 第四个单元格' cellsToExtract(5) = Array(5, 3, "备注") ' 第五个单元格' 实际要处理的单元格数量（根据上面的配置修改）Dim cellCount As Integer: cellCount = 4 ' 目前配置了3个单元格' ---------------------------------------------------' 让用户手动选择Word文档docPath = Application.GetOpenFilename( _FileFilter:="Word文档 (*.doc; *.docx), *.doc; *.docx", _Title:="请选择要提取数据的Word文档")' 检查用户是否取消选择If docPath = False ThenMsgBox "未选择任何文件，程序将退出。", vbInformationExit SubEnd If' 创建Word应用对象Set wdApp = CreateObject("word.application")On Error Resume Next' 尝试打开选中的Word文档wdApp.Documents.Open (docPath)If Err.Number <> 0 ThenMsgBox "无法打开选中的Word文档，请确认文件未被占用且格式正确。", vbCriticalwdApp.QuitSet wdApp = NothingExit SubEnd IfOn Error GoTo 0wdApp.Visible = False ' 后台运行，不显示Word界面' 检查目标工作表是否存在On Error Resume NextSet targetSheet = ThisWorkbook.Sheets(targetSheetName)If Err.Number <> 0 Then' 如不存在则创建新工作表Set targetSheet = ThisWorkbook.Sheets.AddtargetSheet.Name = targetSheetNameEnd IfOn Error GoTo 0' 清空目标工作表现有内容targetSheet.Cells.Clear' 设置表头For j = 1 To cellCounttargetSheet.Cells(1, j) = cellsToExtract(j)(2) ' 第三个元素是表头名称Next j' 获取Word文档中表格总数n = wdApp.ActiveDocument.Tables.CountIf n = 0 ThenMsgBox "所选Word文档中未发现表格！", vbInformationwdApp.QuitSet wdApp = NothingSet targetSheet = NothingExit SubEnd If' 从第2行开始写入数据excel_line_no = 2' 循环提取每个表格的数据For i = 1 To nFor j = 1 To cellCountOn Error Resume Next' 提取表格中自定义单元格的内容Dim row As Integer: row = cellsToExtract(j)(0)Dim col As Integer: col = cellsToExtract(j)(1)' 检查单元格是否存在If row <= wdApp.ActiveDocument.Tables(i).Rows.Count And _col <= wdApp.ActiveDocument.Tables(i).Columns.Count ThencellValue = wdApp.ActiveDocument.Tables(i).Cell(row, col).Range.TextElsecellValue = "单元格不存在"End IfOn Error GoTo 0' 去除文本中的特殊符号（Word单元格文本末尾标记）cellValue = Replace(cellValue, Chr(13) & Chr(7), "")' 将数据写入目标工作表targetSheet.Cells(excel_line_no, j) = cellValueNext jexcel_line_no = excel_line_no + 1Next i' 格式化表头With targetSheet.Rows(1).Font.Bold = True.Interior.Color = RGB(200, 200, 200)End WithtargetSheet.UsedRange.EntireColumn.AutoFit ' 自动调整列宽' 清理资源wdApp.Quit SaveChanges:=wdDoNotSaveChangesSet wdApp = NothingSet targetSheet = NothingMsgBox "数据提取完成！共处理 " & n & " 个表格，提取了 " & cellCount & " 个单元格数据。", vbInformation
End Sub