求助，想用宏实现一维数据转二维格式

灿烂的胖大海

原始数据如图一（我也不知道这是不是叫一维数据-_-||），就是想做个宏，点一下变成图二表格这样行列的格式。


数据量有点大，用公式太卡了，数据透视经常更新时出错，所以也不用，只想用宏实现，请各位大神帮帮忙

ykcbf1100

全表自动生成

附件供参考。。。

ykcbf1100

参与一下。。。

quqiyuan

参与一下，仅供参考。。。
根据源表一次完成

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("原始")
    arr = sht.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    Set d1 = CreateObject("scripting.dictionary")
    n = 2
    For i = 2 To UBound(arr)
        s = arr(i, 1) & "|" & arr(i, 2): ss = arr(i, 3) & "|" & arr(i, 4)
        If Not d1.exists(ss) Then n = n + 1: d1(ss) = n
        If Not d.exists(s) Then Set d(s) = CreateObject("scripting.dictionary")
        d(s)(ss) = d(s)(ss) + arr(i, 5)
    Next
    ReDim brr(1 To UBound(arr), 1 To n)
    n = 1
    brr(n, 1) = "产品代码": brr(n, 2) = "产品"
    n = n + 1
    For Each k In d.keys
        s = Split(k, "|")
        n = n + 1
        brr(n, 1) = s(0): brr(n, 2) = s(1)
        For Each kk In d(k).keys
            If d1.exists(kk) Then
                s = Split(kk, "|")
                brr(1, d1(kk)) = s(0)
                brr(2, d1(kk)) = s(1)
                brr(n, d1(kk)) = d(k)(kk)
            End If
        Next
    Next
    With wb.Sheets("汇总")
        .[j1].CurrentRegion.Clear
        .[j1].Resize(n, UBound(brr, 2)) = brr
        .[j1].Resize(2, 1).Merge
        .[k1].Resize(2, 1).Merge
        With .[j1].CurrentRegion
            .Borders.LineStyle = 1
            .HorizontalAlignment = xlCenter
            .Columns.AutoFit
        End With
    End With
    Set d = Nothing
    Set d1 = Nothing
    Beep
End Sub

lizhipei78

大数据，JSA可能更快



JSA一维数据转二维.rar (10.69 KB, 下载次数: 9)

2024-10-9 16:03 上传

点击文件名下载附件

Askinofblue

这个需求用表堆堆

数据透视函数，只需一个函数就可以搞定了



百度了解一下表堆堆吧

准提部林

源表若未排序, 結果表可能還須加工排一排//

blackttea1

学习啦，谢谢分享。

sxbjzjf110

参与一下。。。。