vba實現excel多行一列轉多行多列

選中部分數據區域（多行一列），例如：

轉換後：

vba代碼：

Sub oneToMany()
   Dim TheRng, TempArr
   Dim i As Integer, j As Integer, colCount As Integer
   Set Dict = CreateObject("Scripting.Dictionary")
   Set Dict2 = CreateObject("Scripting.Dictionary")
   On Error GoTo line1
   If Selection.Cells.Count = 1 Then
     Sheets("Sheet2").Range("a1") = Selection
   Else
     TheRng = Selection
     If UBound(TheRng, 1) Mod 3 = 0 Then
       colCount = UBound(TheRng, 1) / 3
     Else
       colCount = (UBound(TheRng, 1) / 3) + 1
     End If
     ReDim TempArr(1 To 3, 1 To colCount)
     For j = 1 To colCount
       For k = 1 To 3
         If ((j - 1) * 3 + k) <= UBound(TheRng, 1) Then
           TempArr(k, j) = TheRng((j - 1) * 3 + k, 1)
         End If
       Next
     Next
     Sheets("Sheet2").Cells.ClearContents
     Sheets("Sheet2").Cells(1, 1).Resize(UBound(TempArr, 1), UBound(TempArr, 2)) = TempArr
    End If
line1:
End Sub