已知Word内容格式固定，通过宏实现Word转Excel

news2025/7/10 5:26:48

文章目录

  • 需求描述
  • 一、宏是什么？
  • 二、使用步骤
    • 1.启用开发工具
    • 2.VBA基础知识
    • 3.单个Word文件转为Excel
    • 4.批量将Word文件转为Excel文件
  • 总结

需求描述

现在有多个Word文档，Word文档格式固定，假如Word内容分为单选题和多选题，每个题目分为：序号、中文或英文"．"、题目描述、中文"（"、答案选项、中文"）"。
举例：
单选题
1．和测试与工具包括（A）
A．啊v哦v我v
B．武侠脚本挂机啊v化工厂
C．3
D．4

2．特色无重码九年创刊不是就他擦还吃不吃开始v查卡布v吧在v额v为日本v我不必（B）
A．擦额hi v
B．参加纪念册看没看
C．3
D．4

多选题
1．读学多爱吃南昌看看选（ACD）
A．1
B．2
C．按实际产能我可没
D．4

2．测试多选啊沉默啊是擦弄完呢偶然恩菲日文（ABCD）
A．1
B．2
C．按此呢女剑客
D．4
在这里插入图片描述

现在需要将Word文档转为Excel，每个Excel表头包括：题目类型、题目编号、题目描述、A选项描述、B选项描述、C选项描述、D选项描述、答案
例如：
在这里插入图片描述

一、宏是什么？

在Word中，宏是一个批量处理程序命令，可以在Word自带的Visual Basic for Applications (VBA)编辑器中，通过各种代码实现对Word文档批量处理的功能。

二、使用步骤

1.启用开发工具

在这里插入图片描述
2、“更多” --> “选项”
在这里插入图片描述
3、“自定义功能区” --> “自定义功能区”，勾选"开发工具"。
在这里插入图片描述
4、打开VB
在这里插入图片描述
5、打开"工程资源管理器"
在这里插入图片描述
6、在"模块" --> “插入” --> “模块”
在这里插入图片描述
7、右侧可填入VBA代码
在这里插入图片描述

2.VBA基础知识

基本操作：
1、在VBA中，可以使用下划线符号_作为换行符号的一种方式。 当一行代码过长时，可以在需要换行的地方添加下划线符号，然后在下一行继续编写代码。
2、注释：
1.1 以单引号 ' 开头的，但如果这个符号是在双引号之内的，则视为文本，不做为注释引导符，这个符号后面的内容均为注释内容。
1.2 REM后加注释内容（REM与注释内容要空开），REM可以写在其他语句内，但关键词REM后要加冒号“：”。
3、If 条件一 And 条件二 And 条件三 Then 执行if成功的逻辑
ElseIf 条件一 And 条件二 And 条件三 Then 执行ElseIf成功的逻辑
ElseIf ‘表示If结束
4、支持使用（）进行多条件复合判断，例如If A And (C Or D)。当条件A为true，且条件C 或条件D有一为true时，If为真
5、一切未制定类型的变量都是Variant，可以放入任何数据，包括数组、对象等等，使用ReDim options(1 To 4)函数重构为数组4
6、大于>、小于<、等于=、不等于<>
7、Dim text As String 定义字符串变量text

函数方法：
1、Trim() 是去除字符串头或尾部的空格，但不包含中间的空格。
2、Len(text) 获取text（String）的长度。
3、Left(text, 1) 获取text左数，第一个字符。
4、Mid(text, 1, 1) 获取text字符串，从第1个位置起，取一个字符。
5、Mid(text, 1) 获取text字符串，从第1个位置起，取剩余字符。
6、CInt("1") 将字符串转为整型数v据。
7、InStrRev(text, "（") 从右往左获取text里，左括号“（“的位置，假如text=“擦办法把加粗卡机才能看。”，“。”，可得。的位置为1
8、InStr(text, "（") 从左往右获取text里，左括号“（“的位置。
9、InStr(start, text, "（", mode) 从左往右获取text里"（"的位置，start开始位置（可省略）,mode匹配模式，1文本模式，0二进制模式，文本模式忽略大小写（可省略）。

3.单个Word文件转为Excel

实现将单个Word文档转为Excel文件：
1、VBA代码：

Sub ConvertWordToExcel()
    Dim wdDoc As Document
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim para As Paragraph
    Dim questionType As String
    Dim questionNumber As Integer
    Dim questionContent As String
    Dim options As Variant
    Dim answer As String
    Dim rowIndex As Integer
    
    ' 初始化Excel应用
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    
    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
    
    ' 写入表头
    xlSheet.Cells(1, 1).Value = "题目类型"
    xlSheet.Cells(1, 2).Value = "题目编号"
    xlSheet.Cells(1, 3).Value = "题目内容"
    xlSheet.Cells(1, 4).Value = "选项A"
    xlSheet.Cells(1, 5).Value = "选项B"
    xlSheet.Cells(1, 6).Value = "选项C"
    xlSheet.Cells(1, 7).Value = "选项D"
    xlSheet.Cells(1, 8).Value = "答案"
    
    rowIndex = 2
    
    ' 初始化选项数组
    ReDim options(1 To 4)
    options(1) = ""
    options(2) = ""
    options(3) = ""
    options(4) = ""
    
    ' 遍历每个段落
    For Each para In ActiveDocument.Paragraphs
        Dim text As String
        text = Trim(para.Range.text)
        
        If Len(text) > 0 Then
            If Left(text, 1) = "单" Or Left(text, 1) = "多" Then
                questionType = text
                questionNumber = 0
                questionContent = ""
                ReDim options(1 To 4)
                options(1) = ""
                options(2) = ""
                options(3) = ""
                options(4) = ""
                answer = ""
            ElseIf IsNumeric(Left(text, 1)) And (InStr(2, text, "．") > 1 Or InStr(2, text, ".") > 1) Then
                ' 提取题目编号和题目内容
                Dim index As Integer
                index = InStr(2, text, "．") + InStr(2, text, ".")
                questionNumber = CInt(Left(text, index - 1))
                questionContent = Trim(Mid(text, index + 1, InStrRev(text, "（") - index - 1))
                answer = Mid(text, InStrRev(text, "（") + 1, InStrRev(text, "）") - InStrRev(text, "（") - 1)
            ElseIf Left(text, 1) = "A" Or Left(text, 1) = "B" Or Left(text, 1) = "C" Or Left(text, 1) = "D" Then
                Dim optionIndex As Integer
                optionIndex = Asc(Mid(text, 1, 1)) - 64 ' A -> 1, B -> 2, etc.
                options(optionIndex) = Mid(text, 3)
            End If
            
            ' 检查是否已经收集完一个问题的所有信息
            If questionType <> "" And questionNumber > 0 And questionContent <> "" And _
               (Len(options(1)) > 0 And Len(options(2)) > 0 And Len(options(3)) > 0 And Len(options(4)) > 0) And _
               answer <> "" Then
                
                xlSheet.Cells(rowIndex, 1).Value = questionType
                xlSheet.Cells(rowIndex, 2).Value = questionNumber
                xlSheet.Cells(rowIndex, 3).Value = questionContent
                xlSheet.Cells(rowIndex, 4).Value = options(1)
                xlSheet.Cells(rowIndex, 5).Value = options(2)
                xlSheet.Cells(rowIndex, 6).Value = options(3)
                xlSheet.Cells(rowIndex, 7).Value = options(4)
                xlSheet.Cells(rowIndex, 8).Value = answer
                
                rowIndex = rowIndex + 1
                
                ' 重置变量以便处理下一个问题
                questionNumber = 0
                questionContent = ""
                ReDim options(1 To 4)
                options(1) = ""
                options(2) = ""
                options(3) = ""
                options(4) = ""
                answer = ""
            End If
        End If
    Next para
    
    ' 自动调整列宽
    xlSheet.Columns.AutoFit
    
    ' 获取当前打开的Word文档的完整路径
    fileName = ActiveDocument.FullName
    
    ' 保存Excel文件
    Dim excelFileName As String
    excelFileName = Replace(fileName, ".docx", ".xlsx")
    xlBook.SaveAs excelFileName
    xlBook.Close SaveChanges:=False
    
    ' 清理对象
    xlApp.Quit
    Set xlBook = Nothing
    Set xlSheet = Nothing
    
    MsgBox "转换完成！", vbInformation
End Sub

2、将以上代码复制粘贴到区域，并保存。
在这里插入图片描述
3、“开发工具” --> “宏” --> 选择宏名 --> “运行”。
在这里插入图片描述
4、已生成Word同名的Excel文件。
在这里插入图片描述
5、Excel文件内容如下：
在这里插入图片描述

4.批量将Word文件转为Excel文件

实现批量将Word文档转为Excel文件

Sub BatchConvertWordToExcel()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim folderPath As String
    Dim fileName As String
    Dim questionType As String
    Dim questionNumber As Integer
    Dim questionContent As String
    Dim options As Variant
    Dim answer As String
    Dim rowIndex As Integer
    
    ' 初始化Excel应用
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    
    xlApp.Visible = True
    
    ' 设置文件夹路径
    folderPath = InputBox("请输入包含Word文档的文件夹路径:")
    
    If folderPath = "" Then Exit Sub
    
    ' 遍历文件夹中的所有Word文档
    fileName = Dir(folderPath & "\*.docx")
    
    Do While fileName <> ""
        ' 打开Word文档
        Set wdApp = CreateObject("Word.Application")
        wdApp.Visible = False
        
        Set wdDoc = wdApp.Documents.Open(folderPath & "\" & fileName)
        
        ' 创建新的Excel工作簿
        Set xlBook = xlApp.Workbooks.Add
        Set xlSheet = xlBook.Sheets(1)
        
        ' 写入表头
        xlSheet.Cells(1, 1).Value = "题目类型"
        xlSheet.Cells(1, 2).Value = "题目编号"
        xlSheet.Cells(1, 3).Value = "题目内容"
        xlSheet.Cells(1, 4).Value = "选项A"
        xlSheet.Cells(1, 5).Value = "选项B"
        xlSheet.Cells(1, 6).Value = "选项C"
        xlSheet.Cells(1, 7).Value = "选项D"
        xlSheet.Cells(1, 8).Value = "答案"
        
        rowIndex = 2
        
        ' 初始化选项数组
        ReDim options(1 To 4)
        options(1) = ""
        options(2) = ""
        options(3) = ""
        options(4) = ""
        
        ' 遍历每个段落
        Dim para As Paragraph
        For Each para In wdDoc.Paragraphs
            Dim text As String
            text = Trim(para.Range.text)
            
            If Len(text) > 0 Then
                If Left(text, 1) = "单" Or Left(text, 1) = "多" Then
                    questionType = text
                    questionNumber = 0
                    questionContent = ""
                    ReDim options(1 To 4)
                    options(1) = ""
                    options(2) = ""
                    options(3) = ""
                    options(4) = ""
                    answer = ""
                ElseIf IsNumeric(Left(text, 1)) And (InStr(2, text, "．") > 1 Or InStr(2, text, ".") > 1) Then
                    ' 提取题目编号和题目内容
                    Dim index As Integer
                    index = InStr(2, text, "．") + InStr(2, text, ".")
                    questionNumber = CInt(Left(text, index - 1))
                    questionContent = Trim(Mid(text, index + 1, InStrRev(text, "（") - index - 1))
                    questionNumber = CInt(Left(text, 1))
                    questionContent = Trim(Mid(text, 3, InStrRev(text, "（") - 3))
                    answer = Mid(text, InStrRev(text, "（") + 1, InStrRev(text, "）") - InStrRev(text, "（") - 1)
                ElseIf Left(text, 1) = "A" Or Left(text, 1) = "B" Or Left(text, 1) = "C" Or Left(text, 1) = "D" Then
                    Dim optionIndex As Integer
                    optionIndex = Asc(Mid(text, 1, 1)) - 64 ' A -> 1, B -> 2, etc.
                    options(optionIndex) = Mid(text, 3)
                End If
                
                ' 检查是否已经收集完一个问题的所有信息
                If questionType <> "" And questionNumber > 0 And questionContent <> "" And _
                   (Len(options(1)) > 0 And Len(options(2)) > 0 And Len(options(3)) > 0 And Len(options(4)) > 0) And _
                   answer <> "" Then
                    
                    xlSheet.Cells(rowIndex, 1).Value = questionType
                    xlSheet.Cells(rowIndex, 2).Value = questionNumber
                    xlSheet.Cells(rowIndex, 3).Value = questionContent
                    xlSheet.Cells(rowIndex, 4).Value = options(1)
                    xlSheet.Cells(rowIndex, 5).Value = options(2)
                    xlSheet.Cells(rowIndex, 6).Value = options(3)
                    xlSheet.Cells(rowIndex, 7).Value = options(4)
                    xlSheet.Cells(rowIndex, 8).Value = answer
                    
                    rowIndex = rowIndex + 1
                    
                    ' 重置变量以便处理下一个问题
                    questionNumber = 0
                    questionContent = ""
                    ReDim options(1 To 4)
                    options(1) = ""
                    options(2) = ""
                    options(3) = ""
                    options(4) = ""
                    answer = ""
                End If
            End If
        Next para
        
        ' 自动调整列宽
        xlSheet.Columns.AutoFit
        
        ' 保存Excel文件
        Dim excelFileName As String
        excelFileName = Replace(fileName, ".docx", ".xlsx")
        xlBook.SaveAs folderPath & "\" & excelFileName
        xlBook.Close SaveChanges:=False
        
        ' 关闭Word文档
        wdDoc.Close SaveChanges:=False
        wdApp.Quit
        
        ' 清理对象
        Set wdDoc = Nothing
        Set wdApp = Nothing
        Set xlBook = Nothing
        Set xlSheet = Nothing
        
        ' 获取下一个文件名
        fileName = Dir
    Loop
    
    ' 推出xsl
    xlApp.Quit
    
    MsgBox "所有文档转换完成！", vbInformation
End Sub

2、将以上代码复制粘贴到区域，并保存。
在这里插入图片描述

3、“开发工具” --> “宏” --> 选择宏名 --> “运行”。
需要当前文档不在批量处理的路径下
假如需要批量处理“C:\ChangeWord”文件夹下的word文档，需要打开另一个路径下的word（否则会出现循环打开文件，出现异常），触发宏，在弹出的框里输入路径。
在这里插入图片描述
在这里插入图片描述
在这里插入图片描述

4、已生成Word同名的Excel文件。
在这里插入图片描述

总结

通过上述方法，支持将单个Word转为Excel，也支持批量处理Word文档，转为Excel，可根据具体情况，采用不同的方式。

本文来自互联网用户投稿，该文观点仅代表作者本人，不代表本站立场。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如若转载，请注明出处：http://www.coloradmin.cn/o/2331386.html

如若内容造成侵权/违法违规/事实不符，请联系多彩编程网进行投诉反馈，一经查实，立即删除！

相关文章

SpringDoc【使用详解】

SpringDoc【使用详解】

SpringDoc使用详解 一、何为SpringDoc二、概念解释三、SpringDoc使用2.1简单集成2.2 配置SpringDoc2.2.1 yml方式配置2.2.2配置文档信息 2.3配置文档分组2.4使用注解2.4.1 Tag2.4.2 Operation2.4.3 Schema2.4.4 NotNull2.4.5 Parameter2.4.6 Parameters2.4.7 ApiResponses 和Ap…
阅读更多...
Redis持久化 | RDB AOF | 常见问题

Redis持久化 | RDB AOF | 常见问题

目录 RDB&#xff08;Redis DataBase&#xff09; 给什么内存数据做快照——&#xff08;全量&#xff09; 触发机制 RDB文件生成的时候会阻塞主线程吗&#xff1f; 关闭持久化命令 bgsave执行流程 RDB文件怎么配置&#xff1f;有哪些优缺点 优点&#xff1a; 缺点&am…
阅读更多...
判断矩阵A是否可以相似对角化

判断矩阵A是否可以相似对角化

【例题1】 【例题2】
阅读更多...
React 列表渲染

React 列表渲染

开发环境&#xff1a;Reacttsantd 你可能经常需要通过 JavaScript 的数组方法 来操作数组中的数据&#xff0c;从而将一个数据集渲染成多个相似的组件。在这篇文章中&#xff0c;你将学会如何在 React 中使用 filter() 筛选需要渲染的组件和使用 map() 把数组转换成组件数组。 …
阅读更多...
[ctfshow web入门] web25

[ctfshow web入门] web25

信息收集 要想拿到flag&#xff0c;需要突破两层if。 解题 第一个if 传入r0&#xff0c;拿到mt_rand的值&#xff0c;由于每一次访问都会重新设置种子&#xff0c;所以每一次访问都是一样的随机数。 所以我们的r mt_rand-显示的值 1799250188 r1799250188就可以突破第一…
阅读更多...
【数据结构】树的介绍

【数据结构】树的介绍

目录 一、树1.1什么是树&#xff1f;1.2 树的概念与结构1.3树的相关术语1.4 树形结构实际运用场景 二、二叉树2.1 概念与结构2.2 特殊的二叉树2.2.1 满二叉树2.2.2 完全二叉树 个人主页&#xff0c;点击这里~ 数据结构专栏&#xff0c;点击这里~ 一、树 1.1什么是树&#xff1…
阅读更多...
Android源码之App启动

Android源码之App启动

目录 App启动概述 App启动过程 App启动过程图 源码概述 跨进程启动 进程内启动 下面以应用桌面Launcher启动App的MainActivity来举例&#xff1a; App启动概述 首先&#xff0c;MainActivity是由Launcher组件来启动的&#xff0c;而Launcher又是通过Activity管理服务Act…
阅读更多...
【GESP】C++二级练习 luogu-B3721 [语言月赛202303] Stone Gambling S

【GESP】C++二级练习 luogu-B3721 [语言月赛202303] Stone Gambling S

GESP二级练习&#xff0c;多层循环分支练习&#xff0c;难度★✮☆☆☆。 题目题解详见&#xff1a;https://www.coderli.com/gesp-2-luogu-b3721/ 【GESP】C二级练习 luogu-B3721 [语言月赛202303] Stone Gambling S | OneCoderGESP二级练习&#xff0c;多层循环分支练习&am…
阅读更多...
2. Qt界面文件原理

2. Qt界面文件原理

本节主要介绍ui文件如何与窗口关联&#xff0c;并通过隐式连接方式显示对话框 本文部分ppt、视频截图原链接&#xff1a;[萌马工作室的个人空间-萌马工作室个人主页-哔哩哔哩视频] 1 UI文件如何与窗口关联 1.1 mainwindow.cpp的头文件ui_mainwindow.h 根据编译原理的基本规…
阅读更多...
Elastic 的 OpenTelemetry 分发版（EDOT）现已正式发布：开源、可用于生产环境的 OTel

Elastic 的 OpenTelemetry 分发版（EDOT）现已正式发布：开源、可用于生产环境的 OTel

作者&#xff1a;来自 Elastic Miguel Luna 及 Bahubali Shetti Elastic 自豪地宣布正式发布 Elastic OpenTelemetry 分发版&#xff08;Elastic Distributions of OpenTelemetry - EDOT&#xff09;&#xff0c;其中包含 Elastic 自定义版本的 OpenTelemetry Collector 以及多…
阅读更多...
docker部署jenkins并成功自动化部署微服务

docker部署jenkins并成功自动化部署微服务

一、环境版本清单&#xff1a; docker 26.1.4JDK 17.0.28Mysql 8.0.27Redis 6.0.5nacos 2.5.1maven 3.8.8jenkins 2.492.2 二、服务架构&#xff1a;有gateway&#xff0c;archives&#xff0c;system这三个服务 三、部署步骤 四、安装linux 五、在linux上安装redis&#…
阅读更多...
【NLP 53、投机采样加速推理】

【NLP 53、投机采样加速推理】

目录 一、投机采样 二、投机采样改进&#xff1a;美杜莎模型 流程 改进 三、Deepseek的投机采样 流程 Ⅰ、输入文本预处理 Ⅱ、引导模型预测 Ⅲ、候选集筛选&#xff08;可选&#xff09; Ⅳ、主模型验证 Ⅴ、生成输出与循环 骗你的&#xff0c;其实我在意透了 —— 25.4.4 一、…
阅读更多...
VScode连接CentOS 7.6虚拟机

VScode连接CentOS 7.6虚拟机

本文内容&#xff1a;在Windows上使用VMware运行虚拟机&#xff0c;然后使用VScode连接CentOS 7.6虚拟机。 进入系统前 安装VMware 安装教程参考&#xff1a;VMware安装 下载CentOS 7.6镜像 可以使用国内镜像源&#xff0c;但是一般国内镜像源要么已经不维护CentOS 7.6这个…
阅读更多...
高德地图 3D 渲染-区域纹理图添加

高德地图 3D 渲染-区域纹理图添加

引入-初始化地图&#xff08;关键代码&#xff09; // 初始化页面引入高德 webapi -- index.html 文件 <script src https://webapi.amap.com/maps?v2.0&key您申请的key值></script>// 添加地图容器 <div idcontainer ></div>// 地图初始化应该…
阅读更多...
搭建hadoop集群模式并运行

搭建hadoop集群模式并运行

3.1 Hadoop的运行模式 先去官方看一看Apache Hadoop 3.3.6 – Hadoop: Setting up a Single Node Cluster. 本地模式&#xff1a;数据直接存放在Linux的磁盘上&#xff0c;测试时偶尔用一下 伪分布式&#xff1a;数据存放在HDFS&#xff0c;公司资金不足的时候用 完全分布式&a…
阅读更多...
Qt实现鼠标右键弹出弹窗退出

Qt实现鼠标右键弹出弹窗退出

Qt鼠标右键弹出弹窗退出 1、鼠标右键实现1.1 重写鼠标点击事件1.2 添加头文件1.3 添加定义2、添加菜单2.1添加菜单头文件2.2创建菜单对象2.3 显示菜单 3、添加动作3.1添加动作资源文件3.2 添加头文件3.3 创建退出动作对象3.4菜单添加动作对象 4、在当前鼠标位置显示菜单4.1当前…
阅读更多...
Springboot整合Mybatis+Maven+Thymeleaf学生成绩管理系统

Springboot整合Mybatis+Maven+Thymeleaf学生成绩管理系统

前言 该系统为学生成绩管理系统&#xff0c;可以当作学习参考&#xff0c;也可以成为Spirng Boot初学者的学习代码&#xff01; 系统描述 学生成绩管理系统提供了三种角色&#xff1a;学生&#xff0c;老师&#xff0c;网站管理员。主要实现的功能如下&#xff1a; 登录 &a…
阅读更多...
C#里第一个WPF程序

C#里第一个WPF程序

WPF程序对界面进行优化，但是比WINFORMS的程序要复杂很多， 并且界面UI基本上不适合拖放，所以需要比较多的时间来布局界面， 产且需要开发人员编写更多的代码。 即使如此，在面对诱人的界面表现， 随着客户对界面的需求提高，还是需要采用这样的方式来实现。 界面的样式采…
阅读更多...
PyTorch 生态迎来新成员：SGLang 高效推理引擎解析

PyTorch 生态迎来新成员：SGLang 高效推理引擎解析

SGLang 现已正式融入 PyTorch 生态系统&#xff01;此次集成确保了 SGLang 符合 PyTorch 的技术标准与最佳实践&#xff0c;为开发者提供了一个可靠且社区支持的框架&#xff0c;助力大规模语言模型&#xff08;LLM&#xff09;实现高效且灵活的推理。 如需深入了解 PyTorch…
阅读更多...
时序数据库 TDengine Cloud 私有连接实战指南：4步实现数据安全传输与成本优化

时序数据库 TDengine Cloud 私有连接实战指南：4步实现数据安全传输与成本优化

小T导读&#xff1a;在物联网和工业互联网场景下&#xff0c;企业对高并发、低延迟的数据处理需求愈发迫切。本文将带你深入了解 TDengineCloud 如何通过全托管服务与私有连接&#xff0c;帮助企业实现更安全、更高效、更低成本的数据采集与传输&#xff0c;从架构解析到实际配…
阅读更多...
推荐文章
最新文章

Copyright @ 2022~2023