在右側(cè)將如下代碼寫(xiě)入2010：

Sub text()

Dim arr, i%, d, j

Dim brr()

Set d = CreateObject("scripting.dictionary")

arr = Sheet3.Range("A1").CurrentRegion

For i = 1 To UBound(arr)

j = Sheet3.Cells(i, 1).Interior.ColorIndex

d(j) = arr(i, 2)

Next

For i = 1 To 56

ReDim Preserve brr(i - 1)

j = Cells(i, 1).Interior.ColorIndex

brr(i - 1) = d(j)

Next

Range("B1").Resize(56, 1) = Application.Transpose(brr)

End Sub