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

excelperfect

标签：VBA，Dictionary对象

有时候，我们想将垂直列表中的数据转换为水平列表，通常可以使用数据透视表来完成。假设数据是唯一ID，并且客户端可以附加到相同的唯一ID，如下图1所示。

图1

要转成下图2所示。

图2

为此，可以采取多种方法。这里选择使用字典捕获唯一ID，并将公司水平地分赋给这些ID。这要求存储数据的数组的大小要灵活。

代码如下：
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

你也可以参照文章：将水平单元格区域转换成垂直单元格区域，完成相反的任务。

注：本文学习整理自thesmallman.com，有兴趣的朋友可以到原网站下载示例工作簿，也可以到知识星球App完美Excel社群下载示例工作簿。