VBA代码：将垂直单元格区域转换成水平单元格区域

代码如下：
Sub CreateHorizontal()
    Dim dic As Object
    Dim ar As Variant
    Dim var As Variant
    Dim r As Range
    Dim i As Integer
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheet1
        For Each r In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Not IsEmpty(r) Then
                If Not dic.exists(r.Value) Then
                    ReDim ar(1)
                    ar(0) = r.Value
                    ar(1) = r.Offset(, 1).Value
                    dic.Add r.Value, ar
                Else
                    ar = dic(r.Value)
                    ReDim Preserve ar(UBound(ar) + 1)
                     ar(UBound(ar)) = r.Offset(, 1).Value
                    dic(r.Value) = ar
                End If
            End If
        Next r
    End With
    var = dic.items
    Set dic = Nothing
    With Sheet2.Range("A2")
        .CurrentRegion.Offset(1).ClearContents
        For i = 0 To UBound(var)
            .Offset(i).Resize(, UBound(var(i)) + 1) = var(i)
        Next i
    End With
End Sub