VBA一维表转二维表

时间:2022-07-22
本文章向大家介绍VBA一维表转二维表,主要内容包括其使用实例、应用技巧、基本知识点总结和需要注意事项,具有一定的参考价值,需要的朋友可以参考一下。

前面说过了二维表转一维表,现在来看看一维表转二维表。

1、需求:

将1个一维表格转换为二维表格:

2、实现方法:

  • 数据透视表

要实现这个方法,其实熟练数据透视表的处理起来是非常的简单的:

  • SQL语句

会SQL语句的处理起来也很简单,只要明白SQL语句就可以:

transform sum(数据) select 项目 from [Sheet1$] group by 项目 pivot 姓名
  • VBA代码实现

使用VBA代码来实现自然也是没有问题的,使用字典来分别记录行和列的序号,然后输出到1个二维数组就可以:

Sub TarnsTable2()
    Dim drow As Object
    Dim dcol As Object

    Set drow = VBA.CreateObject("Scripting.Dictionary")
    Set dcol = VBA.CreateObject("Scripting.Dictionary")

    Dim i As Long
    Dim arr() As Variant
    Dim i_row As Long

    ActiveSheet.AutoFilterMode = False
    i_row = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    arr = Range("A1").Resize(i_row, 3).Value
    
    '记录项目的行号、姓名的列号
    Dim strkey As String
    For i = 2 To i_row
        strkey = VBA.CStr(arr(i, 1))
        If Not drow.Exists(strkey) Then drow(strkey) = drow.Count + 1
        
        strkey = VBA.CStr(arr(i, 2))
        If Not dcol.Exists(strkey) Then dcol(strkey) = dcol.Count + 1
    Next
    
    Dim result() As Variant
    ReDim result(1 To drow.Count + 1, 1 To dcol.Count + 1) As Variant
    result(1, 1) = "项目"
    
    Dim tmp
    tmp = drow.keys()
    '行
    For i = 0 To drow.Count - 1
        result(i + 2, 1) = tmp(i)
    Next
    
    tmp = dcol.keys()
    '列
    For i = 0 To dcol.Count - 1
        result(1, i + 2) = tmp(i)
    Next
    
    Dim prow As Long, pcol As Long
    '数据
    For i = 2 To i_row
        prow = drow(VBA.CStr(arr(i, 1))) + 1
        pcol = dcol(VBA.CStr(arr(i, 2))) + 1
        
        result(prow, pcol) = result(prow, pcol) + VBA.Val(arr(i, 3))
    Next
    Range("E1").Resize(drow.Count + 1, dcol.Count + 1).Value = result
    
    Set drow = Nothing
    Set dcol = Nothing
End Sub