如何将excel表格放到word文档里(如何将Excel中的数据写入Word表?)

之前我们分享了一期小代码，内容是如何将word中表格的数据读入excel……之后有朋友表示知道了，又问如何将excel中的数据写入word……此时此刻，我再一次清醒的意识到，这世界上像我这样好的人已经不多了。

勉强害羞脸……举个例子还是。下图是一张excel表。

再下图是word中的一张excel表

两张表一个处于excel，一个处于word，但求同存异有一个非常重要的共同点：表的布局是一致的，标题的内容和位置一模一样，比如标题都处在第一行等。示例动画如下：

在excel中使用以下小代码可以将excel中的数据写入word：Sub ExcelTableToWord() Dim WdApp As Object Dim objTable As Object

Dim objDoc As Object Dim strPath As String Dim arr As Variant, brr As Variant Dim k As Long, x As Long, y As Long

Dim i As Long, j As Long, Clny As Long On Error Resume Next Set WdApp = CreateObject("Word.Application")

With Application.FileDialog(msoFileDialogFilePicker) .Filters.Add "Word文件", "*.doc*", 1 只显示word文件

.AllowMultiSelect = False 禁止多选文件 If .Show Then strPath = .SelectedItems(1) Else Exit Sub

End With Application.ScreenUpdating = False Application.DisplayAlerts = False arr = [a1].CurrentRegion

excel表格数据读入数组arr Set objDoc = WdApp.documents.Open(strPath) 后台打开用户选定的word文档 For Each objTable In objDoc.tables

遍历word中的表格 x = objTable.Rows.Count y = objTable.Columns.Count For j = 1 To y

遍历表格的标题行，默认标题处于第一行 If Application.Clean(objTable.Cell(1, j).Range.Text) = arr(1, j) Then

如果标题行一致，则将excel表数据写入word For i = 2 To x With objTable.Cell(i, j).Range

.Text = "" .Text = arr(i, j) End With

Next End If Next Next objDoc.Close True: WdApp.Quit Application.ScreenUpdating = True

Application.DisplayAlerts = True Set objDoc = Nothing Set WdApp = Nothing MsgBox "处理完成"End Sub

小贴士：某男和女朋友吵架冷战了，想和好，但她不理，于是给她支付宝转了520元，然后又转1314元。不久她发来一条信息：有诚意的话，一句话不要分开两次说。。。晚安。

亲爱的读者们，感谢您花时间阅读本文。如果您对本文有任何疑问或建议，请随时联系我。我非常乐意与您交流。