设为首页收藏本站|繁體中文

Excel 技巧网

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 10766|bwin官网地址: 5

[Word] 如何用vba代码将excel中数据导入到word表格中?

[复制链接]
发表于 2011-2-25 20:18:14 | 显示全部楼层 |阅读模式
  • 署名作者: KevinChengCW
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品:
  • 适用版本: 2010 2007 2003以前版本 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    Q: 如何用vba代码将excel中数据导入到word表格中?
    A: 代码如下:
    1. Sub test()
    2. Dim mTable As Table, mCell As Cell, Str$, WB, Rng, Dic As Object, Arr, N&, xlApp As Object
    3. On Error Resume Next    '设置容错
    4. Set xlApp = CreateObject("excel.application")   '创建一个excel项目,用于引用excel的函数
    5. Set Dic = CreateObject("scripting.dictionary")  '创建字典用于装载数据
    6. Set WB = GetObject(ThisDocument.Path & "\数据源.xlsx")  '打开数据源文件
    7. With WB.worksheets(1)   '提取数据源文件中第一个表中的指定位置数据
    8.     For Each Rng In .[b2].Resize(.Cells(.Rows.Count, 2).End(3).Row - 1, 1)  '循环指定标题列各单元格
    9.         If Rng <> "" Then Dic.Add Rng.Offset(-1).Value & vbTab & Rng.Value, Join(xlApp.transpose(xlApp.transpose(Rng.Resize(1, .Cells(Rng.Row, .Columns.Count).End(1).Column))), vbTab) '如果数据不为空则存入字典中(因存在相同字段,故与上面单元格字段组合)
    10.     Next Rng
    11. End With
    12. WB.Close False  '关闭数据源文件
    13. Set WB = Nothing    '清空工作簿项目
    14. Set xlApp = Nothing '清空excel项目
    15. For Each mTable In ThisDocument.Tables  '循环本文档中各个表格
    16.     For Each mCell In mTable.Range.Cells    '循环表格中各个单元格
    17.         If mCell.ColumnIndex = 1 And mCell.RowIndex > 1 Then    '如果是表格第二行以上的第一列,则
    18.             Str = ""    '清空字段,防止出错
    19.             Str = Replace(mTable.Cell(mCell.RowIndex - 1, mCell.ColumnIndex).Range.Text, Chr(13) & Chr(7), "") & vbTab & Replace(mCell.Range.Text, Chr(13) & Chr(7), "")    '组合字段,用于与字典的keys进行判断
    20.             If Dic.Exists(Str) Then '如果存在该字段的key,则
    21.                 Arr = Split(Dic(Str), vbTab)    '将item项拆分放入数组
    22.                 For N = LBound(Arr) + 1 To mTable.Range.Columns.Count - 1   '循环数据中第二个到表格列数范围的数组数据
    23.                     mTable.Cell(mCell.RowIndex, mCell.ColumnIndex + N).Range.Text = Format(Arr(N), "#,##0.00")  '将数据依指定格式写入对应单元格中
    24.                 Next N
    25.             End If
    26.         End If
    27.     Next mCell
    28. Next mTable
    29. Set Dic = Nothing   '清空字典项目
    30. End Sub
    复制代码
    也可以利用excel表格中的vba实现此功能。

    评分

    参与人数 1魅力值 +2 收起 理由
    + 2
    成功解决问题

    查看全部评分

    发表于 2011-2-26 12:59:59 | 显示全部楼层
    本帖最后由 蜀郭浪君 于 2011-2-26 14:17 编辑

    1# kevinchengcw
    版主你好 首先感谢您的代码 谢谢 版主您提供的代码很不错 让我很方便 其中我还想增加几个功能 关于格式的问题
    要是上述功能实现比较麻烦我就想实现在数据批量复制的时候 保留原格式粘贴 我就在excel表里面将所有的格式调整好 然后粘贴过去就省得调整格式
    麻烦您了 谢谢!
    再麻烦你制作一个加载宏在右键中添加一个加载项实现这个功能的运用 谢谢
    发表于 2012-2-5 10:43:04 | 显示全部楼层
    K版主:
    怎么使用这个代码?
    发表于 2014-3-6 16:51:57 | 显示全部楼层
    很好
    bwin官网地址

    使用道具 举报

    发表于 2017-12-31 21:09:12 | 显示全部楼层
    凡是用createObject函数的例子都想看一下,特别是用在word中的实例,太少了。
    发表于 2019-1-25 08:01:42 | 显示全部楼层
    学习
    bwin官网地址

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Powered by Discuz! X3.4

    © 2001-2017 Comsenz Inc.

    快速bwin官网地址 返回顶部 返回列表