WORD题库转换成电子表格

chxw68

1. Sub test()
   
2.   Dim wordapp As Object
   
3.   Dim mydoc As Object
   
4.   Dim reg As Object
   
5.   Dim i%, r%
   
6.   Dim brr(1 To 2000, 1 To 9)
   
7.   Set wordapp = CreateObject("word.application")
   
8.   Set reg = CreateObject("vbscript.regexp")
   
9.   With reg
   
10.     .Global = True
    
11.     .MultiLine = True
    
12.     .Pattern = "^\s*[A-Z]、"
    
13.   End With
    
14.   Set mydoc = wordapp.Documents.Open(ThisWorkbook.Path & "" & "请教.doc")
    
15.   With mydoc
    
16.     .Range.ListFormat.ConvertNumbersToText
    
17.     arr = Split(.Range.Text, vbCr)
    
18.   End With
    
19.   mydoc.Close False
    
20.   wordapp.Quit
    
21.   m = 0
    
22.   For i = 0 To UBound(arr)
    
23.     If Len(arr(i)) <> 0 Then
    
24.       If Not reg.test(arr(i)) Then
    
25.         m = m + 1
    
26.         n = 1
    
27.         brr(m, 1) = arr(i)
    
28.       Else
    
29.         n = n + 1
    
30.         brr(m, n) = arr(i)
    
31.       End If
    
32.     End If
    
33.   Next
    
34.   With Worksheets("导入")
    
35.     .Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
36.   End With
    
37. End Sub
    

复制代码

chxw68

修改好了。

hancon

谢谢老师，可是我下载下来点按钮后怎么答案和解析还是在A列呢？

YMFH522132

chxw68 发表于 2015-3-17 22:13
像这样的答案之间必须空两个空格：A、轻缓 坚定  B、急促 兴奋  C、急促 坚定  D、轻缓 兴奋

老师，我用了您的表格进行题库转换，但是D选项无法提取出来，只能提到ABC三个选项，请问是什么问题呢？按照您的要求，是先个选项间都是空了两格的，但是80道选择题，一个D都未出来，麻烦老师指点

chxw68

把文件传上来

635709002

chxw68 发表于 2018-9-19 15:59
把文件传上来

老师您好，这是我的部分题库，麻烦了