Excel应用实践17：快速将多列数据转换成多行数据

学习Excel技术，关注微信公众号：

excelperfect

在我的工作表中，同一行是某学生测试项目和课外兴趣班的全部信息，如下图1所示。

图1：在工作表“InputData”列A至列C中存储学生一般信息，列D至列列W存储着学生测试项目信息。测试项目信息分为“测试项目、测试日期、分数、等级”列，共重复5次（即有5个测试项目）。

图2：在工作表“InputData”列X至列AI存储着学生课外兴趣班信息。课外兴趣班信息分为“课外兴趣班、频次、持续时间、效果”列，共重复了3次。

现在，要将工作表“InputData”同一行中的数据转换成多行数据，并存储到工作表“OutputData”中，如下图3所示。

图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代码，就可快速达到目的，省去了重复操作的繁杂和易出错的烦恼。

上述代码的图片版如下：