一组数据需要从原始的数据转换成要求的数据格式。

这个问题初看起来，只是一个行列转置的问题。但是细看起来，又好像没那么简单。原始有四列，而且还有空白的单元格。这样的话我们就需要运算一下，把四列的数据转换成两列数据，并删掉空白单元格的数据。然后在于要求数据格式就行对比，填入相应的分数数据就可以。具体思路如下：

按照上述的思路，我首先想到了使用数据的方式，然后再进行判断写入数据。过程及代码如下：

代码如下：

Sub tjcj()

Dim arr, i%, k%, kk%, brr()

t = Timer

Application.ScreenUpdating = False

nRow = Sheets("sheet1").Range("a" & Rows.Count).End(3).Row

For kk = 1 To nRow Step 9

With Sheets("sheet1")

arr = .Range("a" & kk).Resize(9, 4)

nArr = UBound(arr)

ReDim brr(1 To 20, 1 To 2)

For i = 1 To nArr

brr(i, 1) = arr(i, 1)

brr(i, 2) = arr(i, 2)

Next i

For i = nArr + 1 To 2 * nArr

brr(i, 1) = arr(i - nArr, 3)

brr(i, 2) = arr(i - nArr, 4)

Next i

End With

With Sheets("sheet2")

nrow1 = Range("a" & Rows.Count).End(3).Row + 1

For i = 1 To UBound(brr)

For j = 1 To UBound(brr)

If Cells(1, i) = brr(j, 1) Then Cells(nrow1, i) = brr(j, 2)

Next j

Next i

End With

Next kk

Application.ScreenUpdating = True

MsgBox "本程序运行时间" & Format(Timer - t, "0.000")

End Sub

但是运行的时候，发现速度过慢，54行的数据处理，需要0.7s。让我想起了试一试用字典的方式。字典可以装入key值，以及与之对应的item值。要求数据的标题栏与key值对比，然后提取item的值，同样可以达到目的。运行结果如下：

代码如下：

我总结了一下，就本例而言，数据及字典的情况：

就是因为arr（i,1）与arr(i,2)是一一对应。对比了arr（i,1），就提取arr（i,2）。同样对比了字典的key值，从而提取item的值。