一维表转为二维表

chxw68

详见附件。

adud

chxw68 发表于 2022-2-15 16:25

非常感谢您的帮助，但里面有一点问题；若某一个人有重复，则统计结果里面也就重复了。见附件

chxw68

修改好了。

jiangxiaoyun

Sub test()
    Dim arr, brr(1 To 10000, 1 To 14)
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    arr = Sheet1.[a1].CurrentRegion.Value
    a = Array("考生号", "姓名", "班级", "语文", "数学", "外语", "物理", "化学", "生物", "历史", "政治", "地理", "信息技术", "思想政治")
    For j = 0 To UBound(a)
        brr(1, j + 1) = a(j)
        d(a(j)) = j + 1
    Next
    r = 1
    For i = 2 To UBound(arr)
        If d(arr(i, 1) & "") = "" Then
            r = r + 1
            d(arr(i, 1) & "") = r
            For j = 1 To 3
                brr(r, j) = arr(i, j)
            Next
        Else
            lr = d(arr(i, 1) & "")
            lc = d(arr(i, 4))
            brr(lr, lc) = arr(i, 4)
        End If
    Next
    With Sheet2
        .Cells.ClearContents
        .[a1].Resize(r, UBound(brr, 2)) = brr
    End With
End Sub

jiangxiaoyun

一维转二维.zip (22.56 KB, 下载次数: 12)

2022-2-15 22:19 上传

点击文件名下载附件

oembin

正在学习数组有需要，学习了

adud

jiangxiaoyun 发表于 2022-2-15 22:19

你这个有错误啊，好多人的考试科目没有统计出来。

zbs6144

=IFERROR(INDEX($D$2:$D$31,SMALL(IF($A$2:$A$31=$G2,ROW($2:$31),4^8),COLUMN(A1))-1),)数组

micch

直接 透视一下

mjm04

=IFERROR(INDEX($D:$D,SMALL(IF(($G2=$A:$A)*($H2=$B:$B)*($I2=$C:$C),ROW($1:$2000),),COLUMN(A1))),"")

数组三键，右拉、下拉