在我的工作表中，同一行是某學生測試項目和課外興趣班的全部信息，如下圖1所示。
圖3：轉換成多行數據的結果。每名學生的“測試項目、測試日期、分數、等級”和“課外興趣班、頻次、持續時間、效果”信息放置在不同的行中。
可以使用VBA代碼來快速完成數據的轉換：
‘設置數組下標從1開始
Option Base 1
‘自定義類型
Type student
info() As Variant
exam(5) As Variant
interest(5) As Variant
End Type
Sub MainOutput()
Dim wks As Worksheet
Dim i As Long
Dim rngInputData As Range
‘獲取要處理的數據區域
Set rngInputData =Worksheets(“InputData”).Range(“A1”).CurrentRegion
Set rngInputData = rngInputData.Offset(1,0). _
Resize(rngInputData.Rows.Count – 1,rngInputData.Columns.Count)
‘調用OutputData過程處理數據
OutputData rngInputData,Worksheets(“OutputData”).Range(“A2”)
‘自動調整列寬
Worksheets(“OutputData”).Range(“A1”).CurrentRegion.Columns.AutoFit
End Sub
Sub OutputData(rngSource AsRange, rngTarget As Range)
Dim titles() As Variant
Dim inputRows As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim stu() As student
‘輸出表標題
titles = Array(“編號”, “姓名”, “性別”, _
“測試項目”, “測試日期”, “分數”, “等級”, _
“課外興趣班”, “頻次”, “持續時間”, “效果”)
‘獲取輸入數據行數并定義數組大小
inputRows = rngSource.Rows.Count
ReDim stu(inputRows)
‘遍歷輸入數據
For i = 1 To inputRows
‘依次將相應數據存放在數組中
With stu(i)
k = 4
‘存儲前3列數據
.info = Range(rngSource.Item(i, 1),rngSource.Item(i, 3))
‘存儲后面重復標題相應的數據
For j = 1 To 5
.exam(j) =Range(rngSource.Item(i, k), rngSource.Item(i, k + 3)).Value
.interest(j) =Range(rngSource.Item(i, k + 20), rngSource.Item(i, k + 23)).Value
k = k + 4
Next j
End With
Next i
‘清空放置數據的工作表
rngTarget.CurrentRegion.ClearContents
‘輸入標題
rngTarget.Offset(-1, 0).Resize(1, 11).Value= titles
k = -1
‘輸入數據
For i = 1 To inputRows
For j = 1 To 5
With stu(i)
If .exam(j)(1, 1) <>”” Or .interest(j)(1, 1) <> “” Then
k = k + 1
rngTarget.Offset(k,0).Resize(1, 3).Value = .info
rngTarget.Offset(k,3).Resize(1, 4).Value = .exam(j)
rngTarget.Offset(k, 7).Resize(1,4).Value = .interest(j)
Else
Exit For
End If
End With
Next j
Next i
End Sub
上述代碼中使用了一些注釋，方便閱讀和理解。要說明的是，代碼使用了自定義類型，很清楚地存儲不同用途的數據，并能夠很方便地調用，這是一個很好的技巧。
此外，本示例再次表明，針對特定的數據整理需求，使用一些VBA代碼，就可快速達到目的，省去了重復操作的繁雜和易出錯的煩惱。
