VBA一维表转二维表

xyj

发布于 2020-07-28 10:31:28

1.8K0

发布于 2020-07-28 10:31:28

文章被收录于专栏：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

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2020-05-01，如有侵权请联系 cloudcommunity@tencent.com 删除

sql