VBA多个WORD文档表格数据写入到EXCEL中

工作提示:

1、当前目录下有多个相同的WORD表格;

2、在EXCEL中新建VBA项目;

3、将WORD表格中的数据读取写入到一条EXCEL记录中去。

'目录下多个WORD表格批量处理

Sub ReadMoreWords2MyExcel()

   Set Exlapp = CreateObject("excel.Application")
   
   Dim MyDoc As Object
   
   Dim MyPath$, MyName$, str$, m%, t$
   
   Dim Brr(1 To 1000, 1 To 66)
   
   Dim iCount As Integer, iii As Integer, kk As Integer, ii As Integer, col As Integer, tt As String, u As String, stxt As String
   
   Dim xCount As Integer
   
   MyPath = ThisWorkbook.Path & "\"
   MyName = Dir(MyPath & "*.doc?")
   m = 0

  
   Do While MyName <> "" '遍历WORD文档
      Set MyDoc = GetObject(MyPath & MyName) '打开WORD文档
     With MyDoc
       m = m + 1 '记录数据条数
       
       With .tables(1)
       
        Brr(m, 1) = m ''将序号数据存入当前工作表的A列4行单位格
        Brr(m, 2) = Application.Clean(.Cell(1, 2).Range) '姓名将word表格第1行第2列姓名的数据存入当前工作表的B列
        Brr(m, 3) = Application.Clean(.Cell(1, 4).Range) '性别将word表格第1行第4列性别的数据存入当前工作表的C列
        Brr(m, 4) = "'" + Application.Clean(.Cell(1, 6).Range) '出生年月将word表格第1行第6列民族的数据存入当前工作表的D列
        
        Brr(m, 5) = Application.Clean(.Cell(2, 2).Range) '民族
        Brr(m, 6) = Application.Clean(.Cell(2, 4).Range) '籍贯
        Brr(m, 7) = Application.Clean(.Cell(2, 6).Range) '党派
        
        Brr(m, 8) = Application.Clean(.Cell(3, 2).Range) '是否有国(境)外永久居留
        Brr(m, 9) = Application.Clean(.Cell(3, 4).Range) '所在代表团
        
        Brr(m, 10) = Application.Clean(.Cell(4, 2).Range) '提名方式
        Brr(m, 11) = Application.Clean(.Cell(4, 4).Range) '健康状况
        Brr(m, 12) = "'" + Application.Clean(.Cell(4, 6).Range) '参加工作时间

        Brr(m, 13) = Application.Clean(.Cell(5, 2).Range) '职称
        Brr(m, 14) = Application.Clean(.Cell(5, 4).Range) '学历学位
        Brr(m, 15) = Application.Clean(.Cell(5, 6).Range) '所学专业
        Brr(m, 16) = Application.Clean(.Cell(5, 8).Range) '个人特长
        
        Brr(m, 17) = Application.Clean(.Cell(6, 2).Range) '毕业院校
        Brr(m, 18) = "'" + Application.Clean(.Cell(6, 4).Range) '身份证号码

        Brr(m, 19) = Application.Clean(.Cell(7, 2).Range) '所属结构
        
        Brr(m, 20) = Application.Clean(.Cell(8, 2).Range) '电子信箱
        Brr(m, 21) = Application.Clean(.Cell(8, 4).Range) '微信号
        
        Brr(m, 22) = Application.Clean(.Cell(9, 2).Range) '通讯地址
        Brr(m, 23) = Application.Clean(.Cell(9, 4).Range) '手机
        
        Brr(m, 24) = Application.Clean(.Cell(10, 2).Range) '邮编
        Brr(m, 25) = Application.Clean(.Cell(10, 4).Range) '传真
        Brr(m, 26) = Application.Clean(.Cell(10, 6).Range) '办公电话
        
        Brr(m, 27) = Application.Clean(.Cell(11, 2).Range) '工作单位及现任(或原任)职务
        
        Brr(m, 28) = Application.Clean(.Cell(12, 2).Range) '简历
        
        Brr(m, 29) = Application.Clean(.Cell(13, 2).Range) '主要表现
        Brr(m, 30) = Application.Clean(.Cell(14, 2).Range) '选举结果
        
        'Brr(m, 33)16行为家庭主要成员开始项
        
        Brr(m, 31) = Application.Clean(.Cell(22, 2).Range) '现任或历任职务情况(地方、届次、任期起止时间)
        Brr(m, 32) = Application.Clean(.Cell(23, 2).Range) '备注
        

        

'-------------为家庭主要成员数据项--------------

kk = 1 '亲属数据表格起始行数

ii = 16 '亲属数据从第16行开始

iii = 5 '亲属数据总行数5

col = 33 '亲属数据开始写入的列数

tt = ""

Do While ii <= 20


     
     If kk <= 5 Then '判断当前行数
     
     
     stxt = Trim(Application.Clean(.Cell(ii, 2).Range))
     If stxt <> "" Then
     tt = tt + stxt + ","
     Brr(m, col) = stxt '称谓
     End If
     
     stxt = Trim(Application.Clean(.Cell(ii, 3).Range))
     If stxt <> "" Then
     tt = tt + stxt + ","
     Brr(m, col + 1) = stxt '姓名
     End If
     
     stxt = Trim(Application.Clean(.Cell(ii, 4).Range))
     If stxt <> "" Then
     tt = tt + stxt + ","
     Brr(m, col + 2) = stxt '出生年月
     End If
     
     stxt = Trim(Application.Clean(.Cell(ii, 5).Range))
     If stxt <> "" Then
     tt = tt + stxt + ","
     Brr(m, col + 3) = stxt '政治面貌
     End If

     stxt = Trim(Application.Clean(.Cell(ii, 6).Range))
     If stxt <> "" Then
     tt = tt + stxt + ","
     Brr(m, col + 4) = stxt '单位职务
     End If

     stxt = Trim(Application.Clean(.Cell(ii, 7).Range))
     If stxt <> "" Then
     tt = tt + stxt + ";"
     Brr(m, col + 5) = stxt '是否外国国籍或者获得国(境)外永久居留资格、长期居留许可
     End If
     
     col = col + 5
     
     End If
     
     col = col + 1
     
     ii = ii + 1

     kk = kk + 1
     
     Loop
        

'-------------为家庭主要成员数据项--------------

       End With
        .Close False '关闭WORD文档
     End With
     MyName = Dir() '下一个WORD文档
     
   Set MyDoc = Nothing '释放对象变量
   
   Loop
   

   Set Exlapp = Nothing '释放对象变量
   
   '输出数据
   
   If m <> 0 Then _
  Worksheets("Sheet1").Range("A5").Resize(m, UBound(Brr, 2)) = Brr 'Sheet1 A列4行单位格开始写入数据
  
  
 End Sub

### 回答1: 可以使用VBA编写代码将Word表格导入到Excel中。具体步骤如下: 1. 打开Word文档,选择要导入的表格。 2. 在Word中按下Alt+F11打开VBA编辑器。 3. 在VBA编辑器中插入一个新的模块。 4. 在新的模块中编写代码,使用Word对象模型中的Table对象和Excel对象模型中的Worksheet对象来实现表格的导入。 5. 运行代码,将表格导入到Excel中。 需要注意的是,导入表格时需要考虑表格的格式和数据类型,以确保导入的数据准确无误。 ### 回答2: 在VBA中将Word表格导入到Excel可以通过使用Microsoft Word和Microsoft Excel对象库来实现。 首先,需要打开Word文档并选择需要导入的表格。通过以下代码可以打开Word文档并选择表格: ``` Sub ImportWordTable() Dim WordApp As Object Dim WordDoc As Object Dim WordTable As Object Set WordApp = CreateObject("Word.Application") Set WordDoc = WordApp.Documents.Open("C:\Users\example.docx") Set WordTable = WordDoc.Tables(1) '此时选定了第一个表格 '以下可以指定具体的某个单元格的值 'WordTable.Cell(1, 1).Range.Text End Sub ``` 接下来,需要将选择的表格中的数据逐行逐列地提取出来,并在Excel中创建一个新的工作簿和工作表来放置这些数据。通过以下代码可以在Excel中创建新工作簿和工作表: ``` Sub ImportWordTable() Dim WordApp As Object Dim WordDoc As Object Dim WordTable As Object Dim ExcelApp As Object Dim ExcelBook As Object Dim ExcelSheet As Object Dim i As Integer Dim j As Integer Set WordApp = CreateObject("Word.Application") Set WordDoc = WordApp.Documents.Open("C:\Users\example.docx") Set WordTable = WordDoc.Tables(1) '此时选定了第一个表格 Set ExcelApp = CreateObject("Excel.Application") Set ExcelBook = ExcelApp.Workbooks.Add() Set ExcelSheet = ExcelBook.Worksheets(1) End Sub ``` 然后,需要使用循环来按行和列的顺序将表格中的数据提取到Excel工作表中。可以使用以下代码来实现: ``` Sub ImportWordTable() Dim WordApp As Object Dim WordDoc As Object Dim WordTable As Object Dim ExcelApp As Object Dim ExcelBook As Object Dim ExcelSheet As Object Dim i As Integer Dim j As Integer Set WordApp = CreateObject("Word.Application") Set WordDoc = WordApp.Documents.Open("C:\Users\example.docx") Set WordTable = WordDoc.Tables(1) '此时选定了第一个表格 Set ExcelApp = CreateObject("Excel.Application") Set ExcelBook = ExcelApp.Workbooks.Add() Set ExcelSheet = ExcelBook.Worksheets(1) For i = 1 To WordTable.Rows.Count For j = 1 To WordTable.Columns.Count ExcelSheet.Cells(i, j) = WordTable.Cell(i, j).Range.Text Next j Next i End Sub ``` 最后,需要关闭Word文档Excel工作簿,并释放所有对象。可以使用以下代码实现: ``` Sub ImportWordTable() Dim WordApp As Object Dim WordDoc As Object Dim WordTable As Object Dim ExcelApp As Object Dim ExcelBook As Object Dim ExcelSheet As Object Dim i As Integer Dim j As Integer Set WordApp = CreateObject("Word.Application") Set WordDoc = WordApp.Documents.Open("C:\Users\example.docx") Set WordTable = WordDoc.Tables(1) '此时选定了第一个表格 Set ExcelApp = CreateObject("Excel.Application") Set ExcelBook = ExcelApp.Workbooks.Add() Set ExcelSheet = ExcelBook.Worksheets(1) For i = 1 To WordTable.Rows.Count For j = 1 To WordTable.Columns.Count ExcelSheet.Cells(i, j) = WordTable.Cell(i, j).Range.Text Next j Next i WordDoc.Close WordApp.Quit ExcelBook.SaveAs("C:\Users\example.xlsx") ExcelBook.Close ExcelApp.Quit Set WordDoc = Nothing Set WordApp = Nothing Set WordTable = Nothing Set ExcelSheet = Nothing Set ExcelBook = Nothing Set ExcelApp = Nothing End Sub ``` 通过以上代码,可以将Word文档中的表格数据成功导入到Excel工作表中。需要注意的是,需要进行正确配置可以确保成功运行此代码,并及时更改相应的文件路径。 ### 回答3: 在VBA中将Word表格导入到Excel是一项非常有用的操作,它可以帮助你快速地将Word中的数据转移到Excel里面,从而进行更方便的处理。 下面是这个过程具体的步骤: 1. 打开需要导入的Word文档,选择需要导入的表格。 2. 打开Excel文档,并在新建的模块中添加以下代码: Sub ImportWordTableInExcel() Dim WordApp As Word.Application Dim WordDoc As Word.Document Dim TableNo As Integer '表格序号 Dim iRow As Long '行号 Dim iCol As Integer '列号 Set WordApp = CreateObject("Word.Application") '打开Word应用程序 WordApp.Visible = True '设置可见性 Set WordDoc = WordApp.Documents.Open(Filename:="C:\Users\johnDoe\Documents\example.docx", _ ReadOnly:=True) '打开Word文档 TableNo = WordDoc.Tables.Count '获取表格数 For Each tbl In WordDoc.Tables '循环遍历每个表格 For iRow = 1 To tbl.Rows.Count '循环遍历每行 For iCol = 1 To tbl.Columns.Count '循环遍历每列 ThisWorkbook.Worksheets(1).Cells(iRow, iCol) = _ Application.Clean(tbl.Cell(iRow, iCol).Range.Text) '将单元格中的文本导入到Excel中 Next iCol '进入下一列 Next iRow '进入下一行 Next tbl '进入下一个表格 WordDoc.Close '关闭Word文档 WordApp.Quit '关闭Word应用程序 End Sub 3. 保存并运行宏,即可将Word中的表格数据导入到Excel中。在导入完成后,你可以根据需要对Excel文档进行进一步的处理。 总的来说,通过VBAWord表格导入到Excel可以大大节省你的时间和精力,同时还可以减少数据输入过程中的错误。希望这份回答可以帮助你更好地掌握这项技能。
评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值