我是职场编码,很高兴见到你!
本期主题:如何快速实现题库分离。
6月是安全生产月,我手工整理了一份安全月试题。
001 需求分析
累不说,累死累活还有不少错误。
一共150道题,算上选项,答案,题干,题型,900+条信息。一条一条整理,岂不是要累死啊?那如何又好又快完成数据整理呢?我说的是把Word题库实现题干、选项、答案分离,保存在Excel里。
002 思路解析
第一步:我们需要打开Word题库。
第二步:我们设定条件分类读取相应文字,写入数组。
第三步:将数组写入Excel。
注:所有功能实现均在引入COM组件的条件下成立。
003 源码展示
【VBA】 Sub tiku_to_excel() '初始化 Dim Wap As New Word.Application Wap.Visible = True Dim Wdc As Word.Document Pth = ThisWorkbook.Path Set Wdc = Wap.Documents.Open(Pth + "/2020年安全生产月全国安全知识网络竞赛活动题库.doc") '变量声明+赋值 Dim s1, s4, s5 As String Dim t Dim Wph As Paragraph Dim Arr(1 To 150, 7) As String Dim i, j As Integer s1 = "A." s4 = "D." s5 = "正确答案" t = Timer '执行 i = 1 For Each Wph In Wdc.Paragraphs j = j + 1 If InStr(1, Wph.Range, s1) = 1 Then Arr(i, 0) = Wdc.Paragraphs(j - 2).Range.Text Arr(i, 1) = Wdc.Paragraphs(j - 1).Range.Text Arr(i, 2) = Wdc.Paragraphs(j).Range.Text Arr(i, 3) = Wdc.Paragraphs(j + 1).Range.Text Arr(i, 4) = Wdc.Paragraphs(j + 2).Range.Text ElseIf InStr(1, Wph.Range, s4) = 1 Then Arr(i, 5) = Wdc.Paragraphs(j).Range.Text ElseIf InStr(1, Wph.Range, s5) = 1 Then Arr(i, 6) = Wdc.Paragraphs(j).Range.Text i = i + 1 End If Next '写入 Cells(1, 1).Resize(150, 7).Value = Arr MsgBox "使用VBA用时:" & Timer - t & " 秒" End Sub
【Ruby】 require "win32ole" # 初始化 Wap=WIN32OLE::new("word.Application");Wap.visible=true Pth=File.dirname(__FILE__) Wdc=Wap.documents.open(Pth+'/2020年安全生产月全国安全知识网络竞赛活动题库.doc') # 变量赋值 s1="A." s4="D." s5="正确答案" arr = Array.new(150){[nil]} # 执行 i=0;(1..Wdc.paragraphs.count).each{|j| if Wdc.paragraphs(j).range.text.index(s1)==0 then arr[i][0] = Wdc.paragraphs(j-2).range.Text arr[i][1] = Wdc.paragraphs(j-1).range.Text arr[i][2] = Wdc.paragraphs(j).range.Text arr[i][3] = Wdc.paragraphs(j+1).range.Text arr[i][4] = Wdc.paragraphs(j+2).range.Text elsif Wdc.paragraphs(j).range.text.index(s4)==0 then arr[i][5] = Wdc.paragraphs(j).range.Text elsif Wdc.paragraphs(j).range.text.index(s5)==0 then arr[i][6] = Wdc.paragraphs(j).range.Text i=i+1 end } # 初始化 Eap=WIN32OLE::new("Excel.Application");Eap.visible=true Ebk=Eap.workbooks.open(Pth+'/tiku_to_excel.xls') # 写入 Ebk.worksheets(1).range("a1").resize(150,7).value=arr
注:双击以.rb结尾的文件运行,用Sublime Text3等文本文件打开,即可获得源代码。(源文件请勿放在中文路径下,否则会执行报错。)