【Excel VBA 编程】读取Word中一堆姓名并自动排成一列显示到Excel中

引言

问题的分析与设计

Word文档读取操作

一堆名字拆分并按列写入Excel单元格

代码入口设计

代码实现

运行结果

回顾总结

引言

如下图，Word文档中有一堆名字，名字中间是用空格隔开的，现在需要将它们逐一分开并输出到Excel表中，排成一列显示，即每个单元格中只能有一个名字

工作中遇到这类问题，大家都是怎么操作的呢？是不是还在用手工一个个粘贴复制过去呢？那样太费时间了，现在就提供给大家一种处理这类问题的方法，一键操作绝对省时省力！按照文中步骤操作，再多的数据也不怕，又有时间去品茶了，惬意！

问题的分析与设计

Word文档读取操作

首先我们需要定义两个特殊变量，WordApp和wordDoc

WordApp就是Word应用，把所有打开的Word文档关闭后（菜单栏顺次选择“文件”、“关闭”）就可以看到它了
至于wordDoc，这个就比较好理解了，我们经常编辑、修改的具体文档，它是和文件存储路径及文件名紧紧绑定在一起的，换句话说只要知道文件存放的路径和文件名我们就能成功得打开word文档了

接着是文档的打开及读取操作

已经创建好的Word文档，想用WordApp打开就需要用到：wordApp.Documents.Open(“完整的路径+文件名”)
可以一段一段的读取Word中内容：wordDoc.Paragraphs(Index).Range.Text

最后关闭打开的Word文档，养成好的习惯，程序有始有终

不需要保存更改，wordDoc.Close SaveChanges:=False，若需要改为True即可
App关闭退出，wordApp.Quit
如果想关闭所有的Word可以使用Set wordApp = Nothing；如果只是想关闭程序中打开的Word，不影响其他Word文件的正常使用，可以不用，根据实际情况来定
释放资源，Set wordDoc = Nothing

一堆名字拆分并按列写入Excel单元格

将获取到的一堆名字进行拆分，最简单的就是正则表达，只需要获取2~3个汉字即可解决，汉字编码区间[u4e00-u9fa5]，因此提取规则设置为：([u4e00-u9fa5]{2,3})

具体的操作可以查看代码实现：regx 及myMatch变量的设置及处理

该功能还可以利用数组实现，可参考前期文章：

【Excel VBA编程】单元格数据拆分成一列OR一列数据汇总到一个单元格，利用数组轻松搞定_excel vba 合并单元格怎样装入数组-CSDN博客

代码入口设计

考虑使用方便，还是选取在Sheet页面插入命令按钮(Active x控件)

第一步：Excel文件首先要另存为.xlsm格式文件，第一次打开.xlsm文件会有安全警告，选择启用即可

第二步：顺次选择工具栏 –开发工具–插入–命令按钮（Active X控件），在表单中的适当位置拖动鼠标即可插入。如果该步骤有问题，可以查看我前期写的公众号文章，里面有详细的步骤：如何快速开始编程还不用搭建环境，那一定就是它了……

第三步：双击添加的命令按钮，快速打开VBA代码并且默认会创建类似如下的两行代码，然后我们只要在中间添加代码就可以通过命令按钮调用了

Private Sub CommandButton1_Click()

End Sub

Sheet页面插入命令按钮后显示

代码实现

执行以下代码前，首先要关联两个库，一个是针对Word操作的库，另一个因为程序中使用了正则表达式，因此还需要引用正则库

具体方法：在VBA编辑器中，点击”工具”菜单,选择”引用”。在弹出的”引用 – VBAProject”对话框中，滚动查找”Microsoft Word XX.0 Object Library(XX代表版本号，如16.0对应Word2016)”，和Microsoft VBScript Regular Expressions 5.5，全部勾选它们，点击”确定”即可

Private Sub CommandButton1_Click()
    Dim wordApp As Object
    Dim wordDoc As Document
    Dim content As String
    Dim i As Long '读取时指定的类型为long，Paragraphs(i)
    Dim FileName As String '界面输入文件路径+文件名，不需要修改代码
    

    Dim ws As Worksheet 'Excel指定Sheet
    Dim iRow As Integer '行号
    
    Dim regx As New RegExp
    Dim myMatch As Object
    
    Set ws = Worksheets("Sheet1")
    FileName = InputBox("请输入Word文档的全路径及文件名（如C:	est名单.docx）")
    
    If FileName <> "" Then  '输入了内容
        'Word文档中内容读取到content变量中
        If Dir(FileName) <> "" Then  '判断是否正确输入了路径及文件名、或者输入的路径和文件名是否存在
            Set wordApp = CreateObject("Word.Application") '创建word应用程序对象
            wordApp.Visible = True   '可见Word窗口
            Set wordDoc = wordApp.Documents.Open(FileName) '，打开Word文档，输入框中输入的文件
            ' 读取文档内容
             content = ""
             For i = 1 To wordDoc.Paragraphs.Count
                 content = content & wordDoc.Paragraphs(i).Range.Text & vbCrLf '
             Next i
         Else
            MsgBox "文件不存在，请确认输入信息是否正确或输入的路径文件是否存在！"
            Exit Sub '程序退出
         End If

        '顺次截取姓名，并输出到Excel中A列中
        iRow = 1
        regx.Pattern = "([u4e00-u9fa5]{2,3})"  '正则表达式匹配规则，提取2~3个汉字,Word文档中姓名之间用空格或是其他符号隔开都可以使用这个规则
        regx.Global = True
        Set myMatch = regx.Execute(content) ' content中存放着全部姓名
        For Each Match In myMatch  '获取全部数字，并拼接到一起就是电话号码
            ws.Cells(iRow, 1).Value = myMatch(iRow - 1).Value '取姓名，使用iRow-1 表示Index，省去一个变量定义
            iRow = iRow + 1 '下一个
        Next Match
    
         '关闭打开的Word文档
    
        wordDoc.Close SaveChanges:=False ' 保存修改True，如果不需要保存更改，设置为False
        wordApp.Quit  '还是要退出来的,否则一个孤零零的Word窗口很难看
        'Set wordApp = Nothing'会将所有Word关闭，影响使用
        Set wordDoc = Nothing
    
        MsgBox "Word中姓名全部读取完毕，并保存到Sheet1中A列，请查看！"
    Else
        MsgBox "没有输入内容，程序退出！"
    End If
End Sub