Excel逆透视列 二维表转一维

奔跑的栗子

想使用excel power query的逆透视列功能，将二维表转换为一维表，在数据少时能成功
可是数据多时就全部都是Error
如附件，10行数据很容易转成功，可是这样的数据有5万4000多行需要转，一直出错，请问有更好的办法吗？





谢谢！

祝洪忠-

使用2019测试，56000行数据源 提示工作表无法存放全部数据，加载后1048576行

comeonllg

没数据不好解决吧

奔跑的栗子

comeonllg 发表于 2021-1-17 11:41
没数据不好解决吧

附件有数据的，只放了10行

泊蓝

模拟了50000行，PQ转一维表还是很快的，不太知道你说的error是哪里的。另外，一维表的200多万行，一般不会去仔细看，都是用作其他统计/分析，也就是，转换之后，上载至链接即可，因为Excel本来也放不下

cjc209

Sub 逆透视列()
    Dim arr, brr(), n%
    Set yssjq = Application.InputBox("请点选:原始数据区域中的任意单元格（包含行标题和列标题）", Type:=8)
    arr = yssjq.CurrentRegion
    qsl = Val(InputBox("请输入:从第几列开始将列字段转向行方向（以区域为参照物）：", "要开始列传行的起始数字列号", "1"))
    bths = Val(InputBox("请输入:列字段表头共有多少行：", "复合表头行数", "1"))
    bb = MsgBox("选择： 是 为忽略空值  否 为允许空值存在", vbYesNo)
    Set jgdyg = Application.InputBox("请点选:存放结果的 起始单元格", Type:=8)
    jgdyg.CurrentRegion.Clear
    For i = qsl To UBound(arr, 2)
        For j = bths + 1 To UBound(arr)
            If bb = 6 Then
                If arr(j, i) <> "" Then
                    n = n + 1
                    ReDim Preserve brr(1 To qsl + bths, 1 To n + 1)
                    For k = 1 To qsl - 1
                        If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                        If Len(arr(j, k)) = 0 Then arr(j, k) = brr(k, n)
                        brr(k, n + 1) = arr(j, k)
                    Next k
                    For k = 1 To bths
                        If Len(arr(k, i)) = 0 Then arr(k, i) = brr(qsl + k - 1, n)
                        If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                        brr(qsl + k - 1, n + 1) = arr(k, i) '循环要转到行的列字段表头
                    Next k
                    If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                    brr(qsl + bths, n + 1) = arr(j, i)
                End If
            Else
                n = n + 1
                ReDim Preserve brr(1 To qsl + bths, 1 To n + 1)
                For k = 1 To qsl - 1
                    If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                    If Len(arr(j, k)) = 0 Then arr(j, k) = brr(k, n)
                    brr(k, n + 1) = arr(j, k)
                Next k
                For k = 1 To bths
                    If Len(arr(k, i)) = 0 Then arr(k, i) = brr(qsl + k - 1, n)
                    If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                    brr(qsl + k - 1, n + 1) = arr(k, i) '循环要转到行的列字段表头
                Next k
                If Len(arr(k, i)) >= 12 Then arr(j, k) = "'" & arr(j, k)
                brr(qsl + bths, n + 1) = arr(j, i)
            End If
        Next
    Next
    For k = 1 To qsl - 1
        brr(k, 1) = arr(1, k) '写入转置字段列之前的标题内容
    Next k
    jgdyg.Resize(UBound(brr, 2), UBound(brr, 1)) = Application.Transpose(brr)
End Sub

奔跑的栗子

泊蓝 发表于 2021-1-18 17:25
模拟了50000行，PQ转一维表还是很快的，不太知道你说的error是哪里的。另外，一维表的200多万行，一般不会 ...

error就是我这里名义标签只放了产品编号，实际上还有几十列其他的标签，比如厂家，生产日期，厂家类型等等，在转完之后这些会变成error
上载至链接的话，还可以对转换后的数据进行写函数，拉数据透视表吗？谢谢