姓名横向排列，成绩纵向排列，想在另一表格里依次调出该生对应的历次成绩

桑榆非晚

各位大神大佬，再请教一下类似的问题，这次姓名横向排列，想在另一表格（sheet2）里，按照G—K中的名字，依次调出该生对应的历次成绩，（有几次算几次）。怎样操作啊，谢谢啦！

凌空一羽

Sub 按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    Application.ScreenUpdating = False
    For j = 3 To UBound(arr)
        d(arr(j, 1)) = d(arr(j, 1)) & "#" & arr(j, 2)
    Next j
    Sheet2.Activate
    For j = 3 To [b3].End(xlToRight).Column
        str1 = Cells(3, j).Value
        If d.exists(str1) Then
            brr = Split(d(str1), "#")
            Cells(3, j).Resize(UBound(brr) + 1, 1) = Application.Transpose(brr)
            Cells(3, j) = str1
        End If
    Next j
    Application.ScreenUpdating = True
End Sub

桑榆非晚

大神，好像不对呢，麻烦修改一下好吗，谢谢啦！

桑榆非晚

这个点 还有没有大神没睡觉，欢迎帮忙，谢谢啦。

lsc900707

桑榆非晚 发表于 2019-7-23 22:19
大神，好像不对呢，麻烦修改一下好吗，谢谢啦！

哪里不对你要具体说出来呀！

张道贤

不懂你到底要什么样的结果，甩个问题不说清楚要什么样的结果

这个不是VB做的，数据透视表完成的

还有为什么要把姓名横排？
难道你的次数比你的人数还多…………

一把小刀闯天下

'估计是输出全部的吧，，，

Option Explicit

Sub test()
  Dim arr, i, dic, n
  Set dic = CreateObject("scripting.dictionary")
  arr = Sheets("sheet1").[a1].CurrentRegion
  ReDim brr(100, UBound(arr, 1)), m(1 To UBound(arr, 1)) As Long
  For i = 3 To UBound(arr, 1)
    If Not dic.exists(arr(i, 1)) Then
      n = n + 1
      dic(arr(i, 1)) = n
      brr(0, n) = arr(i, 1)
    End If
    m(dic(arr(i, 1))) = m(dic(arr(i, 1))) + 1
    brr(m(dic(arr(i, 1))), dic(arr(i, 1))) = arr(i, 2)
    brr(dic(arr(i, 1)), 0) = "成绩" & dic(arr(i, 1))
  Next
  brr(0, 0) = "姓名"
  Sheets("sheet2").[b3].Resize(UBound(brr, 1) + 1, n + 2) = brr
End Sub

deadzlq

PQ参考解法

桑榆非晚

桑榆非晚 发表于 2019-7-23 22:54
这个点 还有没有大神没睡觉，欢迎帮忙，谢谢啦。

我把命令输进去运行宏，结果没啥反应呢

桑榆非晚

deadzlq 发表于 2019-7-24 10:56
PQ参考解法

谢谢您大神，我试试看哦。