如何用vba把一张表中的数据按要求自动导入另一张表？

傻二少

如何用vba把一张表中的数据按要求自动导入另一张表？

从“成绩”中导入各科成绩，并按“分数档”中的成绩自动划出ABCDE档。
顺序可以按“成绩“表中的顺就可以




各位高手帮帮忙！！

半百

请将“分数档”表中A11改成“总分”两字。
Sub test()
Set D = CreateObject("Scripting.Dictionary")
ARR = Sheets("成绩").UsedRange
ReDim CRR(1 To UBound(ARR) - 1, 1 To 17)
BRR = Sheets("分数档").Range("A6:E11")
For I = 1 To 6
    D(BRR(I, 1)) = Array(BRR(I, 2), BRR(I, 3), BRR(I, 4), BRR(I, 5))
Next
For I = 2 To UBound(ARR)
    For J = 1 To 4
        CRR(I - 1, J) = ARR(I, J)
    Next
    For J = 5 To 10
        CRR(I - 1, J * 2 - 5) = ARR(I, J)
        Select Case ARR(I, J)
        Case Is >= D(ARR(1, J))(0)
            S = "A"
        Case Is >= D(ARR(1, J))(1)
            S = "B"
        Case Is >= D(ARR(1, J))(2)
            S = "C"
        Case Is >= D(ARR(1, J))(3)
            S = "D"
        Case Else
            S = "E"
        End Select
        CRR(I - 1, J * 2 - 4) = S
    Next
    CRR(I - 1, 17) = ARR(I, 11)
Next
Sheets("显示分数档").Range("A2").Resize(UBound(ARR) - 1, 17) = CRR
End Sub

傻二少

半百 发表于 2018-6-6 18:17
请将“分数档”表中A11改成“总分”两字。
Sub test()
Set D = CreateObject("Scripting.Dictionary")

非常感谢，可以用了