WORD题库转换成电子表格

考试加油站 · 发表于 2013-12-5 19:36

本帖最后由考试加油站于 2013-12-5 19:40 编辑

chxw68 发表于 2013-12-5 17:28
你的Word试题到底是哪一个？为什么总是变来变去呀？这个程序不能通用的。

7楼是完整的，前面几种都是部分。

\b[A-Z]\..*?($|\x20) 是不是只修改这句话，这句话是什么意思？

chxw68 · 发表于 2013-12-5 20:21

考试加油站发表于 2013-12-5 19:36
7楼是完整的，前面几种都是部分。

\b[A-Z]\..*?($|\x20) 是不是只修改这句话，这句话是什么意思 ...

正则表达式！

wjhere · 发表于 2015-3-15 16:06

学习了，感觉非常厉害。请教，能否有一个正则表达式同时适用下面的三个题目呢：

下列词语错别字最少的一组是( )。
A、震耳欲聋跋山涉水遍体粼伤安然无羊
B、呕心沥血春意盎然沉重其事再接再励
C、流水潺潺斩钉截铁风餐路宿辗转反侧
D、谈笑风声忑忐不安狼狈为干神计妙算
早上好用英语怎样说（）
A、 Good morning
B、 Good afternoon
C、 Good evening
在朗读不论发生什么，我总会跟你在一起。这句话时的声调和语气是（  ）
A、轻缓坚定  B、急促兴奋  C、急促坚定 D、轻缓兴奋

wjhere · 发表于 2015-3-17 19:58

请老师帮忙看看，这个附件里面的文档，有没有通用的正则表达式可以提取呢，谢谢。

chxw68 · 发表于 2015-3-17 22:04

Sub test()
Dim wordapp As Object
Dim mydoc As Object
Dim reg As Object
Dim i%, r%
Dim brr(1 To 2000, 1 To 9)
Set wordapp = CreateObject("word.application")
Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.MultiLine = True
.Pattern = "[A-Z]、.*?(?:\s*\x0A|\x0D|\x20)"
End With
Set mydoc = wordapp.Documents.Open(ThisWorkbook.Path & "" & "请教.doc")
With mydoc
.Range.ListFormat.ConvertNumbersToText
arr = Split(.Range.Text, vbCr)
End With
mydoc.Close False
wordapp.Quit
m = 0
For i = 0 To UBound(arr)
If Len(arr(i)) <> 0 Then
If Not reg.test(arr(i)) Then
m = m + 1
n = 1
brr(m, 1) = arr(i)
Else
Set mh = reg.Execute(arr(i))
For k = 0 To mh.Count - 1
n = n + 1
brr(m, n) = mh(k)
Next
End If
End If
Next
With Worksheets("导入")
.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
End With
End Sub

复制代码

chxw68 · 发表于 2015-3-17 22:13

像这样的答案之间必须空两个空格：A、轻缓坚定 B、急促兴奋 C、急促坚定 D、轻缓兴奋

chxw68 · 发表于 2015-3-17 22:14

Sub test()
Dim wordapp As Object
Dim mydoc As Object
Dim reg As Object
Dim i%, r%
Dim brr(1 To 2000, 1 To 9)
Set wordapp = CreateObject("word.application")
Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.MultiLine = True
.Pattern = "[A-Z]、.*?(\x20{2}|$)"
End With
Set mydoc = wordapp.Documents.Open(ThisWorkbook.Path & "" & "请教.doc")
With mydoc
.Range.ListFormat.ConvertNumbersToText
arr = Split(.Range.Text, vbCr)
End With
mydoc.Close False
wordapp.Quit
m = 0
For i = 0 To UBound(arr)
If Len(arr(i)) <> 0 Then
If Not reg.test(arr(i)) Then
m = m + 1
n = 1
brr(m, 1) = arr(i)
Else
Set mh = reg.Execute(arr(i))
For k = 0 To mh.Count - 1
n = n + 1
brr(m, n) = mh(k)
Next
End If
End If
Next
With Worksheets("导入")
.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
End With
End Sub

复制代码

考试加油站 · 发表于 2015-3-18 17:20

WORD转换成电子表格，情况很复杂，没有可能有一个永恒的公式，要是有的话，相关软件早开发出来了。

wjhere · 发表于 2015-3-20 20:07

谢谢老师，辛苦了，几天没有上网，差点辜负了老师的美意。我正在做一个PPT课件助手，就是很方便地把excel表格题目制作成交互式的PPT题目。但是题库大多是word格式的，要转换的excel格式。您的这种方法非常好用。

hancon · 发表于 2017-12-5 19:55

老师，能帮忙修改下代码再添两列答案和解析吗？谢谢老师！

		自动登录	找回密码
密码			免费注册

[求助] WORD题库转换成电子表格

评分

点评