VBA 字典数据行列转置

Excel VBA练习 2021-07-15

1715

在工作中,我们很多时候需要对数据源维度的改变

比如一维转二维，二维转一维…

一维指的是字段，记录简单的罗列，每一行都是一条完整的记录，每一列用来存放一个字段，相同属性的内容只放在一列里面

而二维相当一张网，在多列中都有相同属性的值，也可以称为交叉报表什么的…

例如下图

这是一张二维表,横向看业务员,纵向看月份,这样我们可以看出小风在1月份的销售业绩为64

如果需要转成一维的表,也就是

这个样子,在13版本以上的Excel中,可以使用Power Query中的逆透视就可以解决

其实这里使用VBA还是比较容易解决的

代码如下

Sub Data_TransPose()
    Dim aRes, aData, intX&, intY&, x&
    aData = Range("B4").CurrentRegion '数据来源
    ReDim aRes(1 To (UBound(aData) - 1) * (UBound(aData, 2) - 1) + 1, 1 To 3) '定义结果数组大小
    x = 1 '初始化变量
    For intX = 2 To UBound(aData) '循环数据源的行位置
       For intY = 2 To UBound(aData, 2) '循环数据源的列位置
            x = x + 1 '累加计数器
            aRes(x, 1) = aData(intX, 1) '写入名字
            aRes(x, 2) = aData(1, intY) '写入月份
            aRes(x, 3) = aData(intX, intY) '写入业绩
       Next
    Next
    aRes(1, 1) = "业务员": aRes(1, 2) = "月份": aRes(1, 3) = "业绩"
    Range("G4").Resize(x, 3) = aRes '输出内容
End Sub

运行效果

代码比较简单,也有注释,这里就不在解析

如果需要将一维表转成二维表又该怎么写呢

用数据透视表就能做到了,不过这里使用的代码来做

也就是字典的关联定位功能

也就是利用了字典的Key关键字必须是唯一性的特点

代码如下

Sub Dic_TransPose()
    Dim Dic As Object
    Dim aRes, aData, intX&, intY&, x&, y&
    aData = Range("G4").CurrentRegion '数据来源
    ReDim aRes(1 To UBound(aData), 1 To 2) '定义结果数组大小
    Set Dic = CreateObject("Scripting.Dictionary") '后期绑定字典
    aRes(1, 1) = "业务员" '结果数组第一个元素写入业务员
    x = 1: y = 1 '初始化变量
    For intX = 2 To UBound(aData) '遍历数据源
        If Not Dic.exists(aData(intX, 1)) Then '判断字典中是否存在关键字姓名
            x = x + 1 '计数器结果数组中的行位置
            Dic(aData(intX, 1)) = x '将姓名作为Key行位置作为Item
            aRes(x, 1) = aData(intX, 1) '结果数组写入姓名
        End If
        If Not Dic.exists(aData(intX, 2)) Then '判断字典中是否存在关键字月份
            y = y + 1 '计数器结果数组中的列位置
            Dic(aData(intX, 2)) = y '将月份作为Key列位置作为Item
            If y > UBound(aRes, 2) Then ReDim Preserve aRes(1 To UBound(aRes), 1 To y)
            '判断列位置是否大于结果数组的列维度,符合条件使用关键字ReDim Preserve重新调整数组大小,并且保留原数组中的元素
            aRes(1, y) = aData(intX, 2) '月份写入结果数组中的列维度
        End If
        aRes(Dic(aData(intX, 1)), Dic(aData(intX, 2))) = aData(intX, 3) '写入业绩
    Next
    Range("K4").Resize(x, y) = aRes '输出内容
    Set Dic = Nothing '释放
End Sub

第9至23行循环遍历数据源

第10至14行,将姓名作为Key,行号作为Item,存入字典,也就是结果数组中的行维度的位置

第15至21行,将月份作为Key,列号作为Item,存入字典,也就是结果数组中的列维度的位置

第22行"Dic(姓名)=结果数组中的行号""Dic(月份)=结果数组中的列号"也就是aRes(行号,列号)=业绩

在上述代码中,利用了字典的特性,以关键字我Key,位置为Item,使多个数据之间存在位置的关联,这个比较重要,希望小伙伴可以好好研究下

当然使用SQL也是可以的

strSQL = "TransForm Sum(业绩) Select 业务员 From " & strSource & " Group By 业务员 Pivot 月份"

示例文件下载:

链接：https://pan.baidu.com/s/1dQ67xallNWiPfvxSp7nBAw

提取码：abcd

收工!

如果小伙伴有好的思路,可以在小编的公众号留言发给小编研究下

文章觉得有用,点个赞+在看,你的每一次点赞和转发就是小编原创的动力

数据库

文章转载自Excel VBA练习，如果涉嫌侵权，请发送邮件至：contact@modb.pro进行举报，并提供相关证据，一经查实，墨天轮将立刻删除相关内容。

VBA 字典 数据行列转置

评论

VBA 字典数据行列转置