“互聯網+”背景下題庫Excel模板自動整理功能的設計與實現*

宋士顯

(浙江旅游職業學院,浙江 杭州 311231)

一、無紙化考試的現狀分析

隨著互聯網的興起，信息技術開始助力教育發展，“互聯網 + 教育”得到全面、深度的融合,使得教育考試模式發生了巨大變化[1]，無紙化考試因其具有的靈活性、科學性、公正性、高效性等優勢，再加上在國家相關政策的推動，正成為教學考試評價的必然趨勢[2]。

目前國內外的無紙化考試平臺有兩種方式：一是單一的課程考核平臺，只適用于課程考核環節；二是綜合學習平臺，比如當下比較流行的云班課,智慧職教平臺等[3]。這些平臺是集教學過程管理、資源庫建設、無紙化考試等功能于一體的綜合性平臺，無紙化考試只是平臺的一個子系統。無論哪種方式，平臺軟件結構都是B/S結構[4],軟件結構示意圖如圖1所示:

圖1 B/S結構無紙化考試系統結構

在B/S結構的無紙化考試系統中，服務器承擔三種角色:

(一)網站服務器

用于設計實現無紙化考試前端的顯示內容、結構及樣式。

(二)數據庫服務器

用于在服務器端存儲數據，目前國內的無紙化考試系統后臺數據庫以關系型數據庫為主，常見的數據有SQL Server數據庫、MySQL數據等[5]。這些數據庫中只能存儲關系型數據表，這就決定了數據庫只能實現單選題、多選題、判斷題等這一類客觀題型的存儲需求。

(三)FTP文件服務器

用于讓教師在瀏覽器端以文件的方式批量上傳試題到服務器中。

目前大多數無紙化考試系統都是用Excel作為試題數據的模板，模板的數據結構一般為以下格式(表1)：

表1 Excel模板常見的數據結構

在Excel模板中，序號、題面、各個選項字段各占一列，每一道試題的題號、題面、選項在同一行依次向右排列，這種數據結構與關系型數據庫中數據的存儲格式一致，因而可以很方便的實現從Excel模板中快速導入數據庫中。然后現實中，教師們積累的試題資源大多為Word文檔格式，數據結構一般為以下格式(圖2)：

圖2 Word文檔數據格式

要將上述Word格式轉化為表1所示的Excel模板中的結構化數據，如果采用手工復制粘貼的方式轉化，那么工作效率將會非常低下，此時可以使用Excel自帶的VBA開發功能進行一定的設計開發，實現由Word格式自動轉化為Excel模板中要求的數據結構，將大大提高工作效率。

二、功能需求分析

要實現Word格式自動轉化為Excel格式，首先需要將Word文檔中所有的試題批量復制粘貼到Excel工作表中，效果如下圖(圖3)所示：

圖3 Word文檔內容復制粘貼到Excel工作表后數據結構

將Word文檔中的試題轉移到Excel工作表中以后，接下來需要詳細分析工作表中的數據結構，為VBA代碼編寫自動實現數據結構調整做準備。

(一)數據清洗

直接復制粘貼到Excel工作表中的數據一般是不能直接來進行處理的，因為在原Word文檔中可能包含一些特殊符號，比如空格、中文標點符號混編等，再比如字母大小寫問題，這些問題一般稱之為雜音，在整理之前需要清除這些雜音，這里可以編寫一個數據清洗的宏過程WashData，自動清除雜音。

(二)提取題號和題面

在清除雜音后，接下來需要自動提取每一道試題的題號和題面。試題的題號和題面的數據結構特點：題號必然是一個自然數，試題的題面緊跟在題號之后。可以利用這一結構特點編寫一個宏過程ExtrIndexContent，由于需要對每一道試題分別提取題號和題面，因此這里必須要結合循環語句。

(三)提取選項

在提取題號和題面之后，接下來需要將每一道試題的所有選項提取出來，依次放在對應題面的右邊。我們注意到每一道試題的選項數量各不相同，有的題目有ABCD四個選項，有的題目有ABCDE五個選項；而且選項的排列結構也各不相同，有的在同一個單元格內顯示，有的分布在多個單元格中，如何實現各種情況下都能夠自動提取所有的選項，這是Excel模板自動整理功能實現的核心。

獲取所有選項需要編寫一個總過程GetOptions，該過程實現的功能比較復雜，需要對過程進行分解，拆分封裝成多個不同的子過程，在分別實現每一個子過程后，最后通過調用子過程的方式實現GetOptions提取所有選項的功能。

第一，需要獲取每一道試題的選項區域，需要封裝一個GetArea函數，所需參數為每道試題的題號，返回值為對應試題所有選項所在的單元格區域。

第二，需要將試題選項單元格區域內的所有選項連接成一個字符串，需要封裝一個GetOptionString函數,所需參數為試題選項對應的單元格區域對象，返回值為由各個選項內容連接成的一個字符串。

第三，在獲取每一道試題的選項字符串之后，需要從字符串中拆分出每一個選項，保存到一個數組變量中，這里需要封裝一個函數GetOptionArray，所需參數為選項字符串，返回值為由各個選項組成的一個數組。由于要對字符串中的每一個選項進行拆分，且每道試題的選項數量不等，要實現拆分功能，還必須再封裝一個GetPart函數，在該函數中進行判斷分揀。

第四，在提取試題的每一個選項存入數組變量后，還需要編寫一個過程將數組中的每一個選項放對應題面的右邊，這里設計一個宏過程ArrayReWrite，實現自動整理過程。

(四)格式整理

在實現整個整理過程后，在Excel工作表會自動產生很多的空行，整理完成以后需要自動刪除多余的空行，并刪除整理前的試題內容，得到可以直接上傳到服務器端的結構化數據模塊。

三、功能設計與實現

(一)數據清洗功能的設計與實現

在數據清洗WashData過程中需要對空格、頓號、點號、英文狀態下左右括號的批量處理，這里需要使用range區域對象的replace方法實現，具體代碼如下：

Sub WashData ()

Dim rng As range

Set rng = ActiveSheet.UsedRange

rng.Replace "、",""

rng.Replace "(",""

rng.Replace ")",""

rng.Replace "(",""

rng.Replace ")",""

rng.Replace ".",""

rng.Replace " ",""

Set rng = Nothing

End Sub

(二)提取題號和題面

在數據清洗后，設計開發提取題號和題面的宏過程ExtrIndexContent。根據每一道試題只在第一行的前面包含序號，選項之前沒有序號這一特點，使用val函數進行判斷,提取序號和題面后分別放到試題首行右邊兩個連續的單元格中，由于需要多道試題進行批量操作，因此這里需要結合循環語句進行，具體代碼如下：

Sub ExtrIndexContent()

Dim rng As range

Dim myRng As range

Dim cel As range

Set rng = ActiveSheet.range("a1048576").End(xlUp)

Set myRng = range(Cells(1,1),rng)

Dim str As String

Dim myIndex As Integer

ForEach cel In myRng

If Val(cel.Value) >0 Then

str = cel.Value

myIndex = Val(str)

cel.Offset(0,1) = myIndex

cel.Offset(0,2) = Right(str,Len(str) - Len(myIndex))

End If

Next

Set rng = Nothing

Set cel = Nothing

End Sub

(三)獲取選項區域對象

在提取每一道試題的題號和題面之后，需要對每一道試題的選項進行處理，首先需要獲取選項所處的區域，這里設計開發GetArea宏函數實現，需要每道試題的序號所在的單元格作為參數，返回值為對應試題選項所在的單元格區域，具體代碼如下：

Function GetArea(rng As range)

Dim rngAns As range

Dim rngNext As range

Set rngNext = rng.End(xlDown)

If rngNext.Row <1048576 Then

Set rngAns = rng.Offset(1,-1).Resize(rngNext.Row - rng.Row - 1,1)

Else

Set rngAns = rng.Offset(1,-1).Resize(ActiveSheet.range("a1048576").End(xlUp).Row - rng.Row,1)

End If

Set GetArea = rngAns

Set rngNext = Nothing

Set rngAns = Nothing

End Function

(四)獲取選項字符串

在獲取每一道試題選項所在的單元格區域后，需要將選項區域內的所有單元格內容連接成一個字符串，這里需要設計一個宏函數GetOptionString，所需參數為試題的選項區域，返回值為區域內單元格數據連接后的字符串，具體代碼如下：

Function GetOptionString(rng As range)

Dim str As String

For i = 1 To rng.Cells.Count

str = str &rng.Cells(i).Value

Next

GetOptionString = str

End Function

(五)獲取選項數組

在獲取選項字符串后，需要將同一道試題所有選項的內容提取出來放到一個數組中，這里需要設計開發一個宏函數GetOptionArray，所需參數為選項字符串，返回值為所有選項內容構成的數組。從選項字符串中提取每一個選項的內容可以單獨封裝成為GetPart函數，在GetOptionArray中調用GetPart函數，獲取每一個選項的內容存入數組中。

Function GetOptionArray(ByVal str As String)

Dim arr(4)

arr(0) = GetPart(str,"A","B")

arr(1) = GetPart(str,"B","C")

arr(2) = GetPart(str,"C","D")

arr(3) = GetPart(str,"D","E")

arr(4) = GetPart(str,"E")

GetOptionArray = arr

End Function

(六)提取選項內容

從選項字符串中提取每一個選項的內容，這個功能可以單獨封裝成一個宏函數GetPart，該函數需要三個參數，第一個參數為選項字符串，第二個參數為要提取的選項名稱，第三個參數為可選參數，用于控制最后一個選項是否存在問題。具體代碼如下所示：

Function GetPart(str As String,First As String,Optional Second)

Dim a As Integer

Dim b As Integer

On Error Resume Next

a = InStr(str,First)

If a = 0 Then Exit Function

If IsMissing(Second) Then

b = Len(str) + 1

Else

temp = InStr(str,Second)

b = IIf(temp = 0,Len(str) + 1,temp)

End If

GetPart = Mid(str,a + Len(First),b - a - Len(First))

On Error GoTo 0

End Function

(七)選項填充

在獲取試題的選項內容數組后，接下來需要將數組中的每一個元素填依次充到題面右邊的單元格中，這里需要設計一個宏過程ArrayReWrite，所需參數為第一道試題對應的題號單元格，具體代碼如下：

Sub ArrayReWrite (rng As range)

Dim rngAns As range

Dim str As String

Dim arr

If rng.Value <>"" Then

Set rngAns = GetArea (rng)

str = GetOptionString (rngAns)

arr = GetOptionArray (str)

rng.Offset(0,2).Resize(1,5) = arr

End If

Set rngAns = Nothing

End Sub

(八)選項提取整體實現

在實現上述1～7步以后，可以將上述7步整合起來，編寫一個宏過程GetOptions，通過過程調用、參數傳遞的方式，實現對單張工作表中所有試題的格式化轉換，具體代碼如下：

Sub GetOptions ()

Dim rng As range

Set rng = ActiveSheet.range("b1:b" &ActiveSheet.range("b1048576").End(xlUp).Row)

For i = 1 To rng.Cells.Count

ArrayReWrite rng.Cells(i)

Next

Set rng = Nothing

End Sub

(九)工作表后期整理

在工作表中對每一道試題進行格式化轉換后，每一道試題的序號、題面、各個選項將自動轉化為以一行的方式顯示，此時原有的試題內容就可以刪除，同時刪除表中多余的空行，轉化為最終Excel模板中要求的數據結構，具體代碼如下：

Sub DeleteBlankRows()

Dim i As Integer

For i = ActiveSheet.range("a1048576").End(xlUp).Row To 1 Step -1

If ActiveSheet.range("b" &i) = "" Then

ActiveSheet.range("b" &i).EntireRow.Delete

End If

Next

ActiveSheet.range("a:a").EntireColumn.Delete

End Sub

(十)主過程調用

上述1～9實現對單張工作表數據的自動整理，為了增強程序的可擴展性，編寫一個主過程main，在該過程中對工作簿中的所有工作表進行循環遍歷，這樣可以實現對所有工作表的批量處理，實現代碼如下：

Sub main()

Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

ws.Activate

WashData

ExtrIndexContent

GetOptions

DeleteBlankRows

Next

Application.ScreenUpdating = True

End Sub

四、結語

本文利用Excel自帶的VBA開發功能，通過編寫相應的代碼，實現Word格式到Excel格式的自動批量轉化，大大提高了工作效率，可以將教師從簡單機械的重復勞動中解放出來，投身于更高價值量的工作當中，具有非常強的使用價值和現實意義。