[已解决]如何制作多次考试成绩单

jhhkh

多次考试成绩表在一工作簿中或几个工作簿中，最后在一张表中出现多次考试的成绩单，如示例,示例中是4次考试，我希望通过VBA实现随便多少次考试最后都能在最后的成绩单中反映出来

最佳答案

月排行榜 / 总排行榜

djyjysxxs

2012-1-8 17:18

不晓得字典，那就改一下：
Sub test()
Dim d , ar1(), ar2(), artmp(), sht As Worksheet
Set d = CreateObject("scripting.Dictionary")
shtc = Worksheets.Count
ReDim ar2(1 To 30000, 1 To 26)
artmp = Sheet1.[a1:y1].Value
For Each sht In Worksheets
   If sht.Name <> "成绩单" Then
      i% = sht.[a65536].End(xlUp).Row
      ar1 = sht.Range("a2:y" & i).Value
      t = t% + 1
      For i = 1 To UBound(ar1)
        If Not d.Exists(ar1(i, 1)) Then d(ar1(i, 1)) = d.Count * shtc + 1
        For i2 = 1 To 25
           If t = 1 Then ar2(d(ar1(i, 1)), i2) = artmp(1, i2)
           ar2(d(ar1(i, 1)) + t, i2) = ar1(i, i2)
        Next
        ar2(d(ar1(i, 1)) + t, 26) = sht.Name
      Next
   End If
Next
Sheets("成绩单").Cells.Clear
Sheets("成绩单").[a1].Resize(d.Count * shtc + t, 26) = ar2
End Sub

跳转到最佳答案楼层

LQ200601

最后的成绩单中反映出来

jhhkh

LQ200601 发表于 2012-1-8 14:04
最后的成绩单中反映出来

???????????????????????????????

djyjysxxs

用了字典，请引用：
Sub test()
Dim d As New Dictionary, ar1(), ar2(), artmp(), sht As Worksheet
shtc = Worksheets.Count
ReDim ar2(1 To 30000, 1 To 26)
artmp = Sheet1.[a1:y1].Value
For Each sht In Worksheets
   If sht.Name <> "成绩单" Then
      i% = sht.[a65536].End(xlUp).Row
      ar1 = sht.Range("a2:y" & i).Value
      t = t% + 1
      For i = 1 To UBound(ar1)
        If Not d.Exists(ar1(i, 1)) Then d(ar1(i, 1)) = d.Count * shtc + 1
        For i2 = 1 To 25
           If t = 1 Then ar2(d(ar1(i, 1)), i2) = artmp(1, i2)
           ar2(d(ar1(i, 1)) + t, i2) = ar1(i, i2)
        Next
        ar2(d(ar1(i, 1)) + t, 26) = sht.Name
      Next
   End If
Next
Sheets("成绩单").Cells.Clear
Sheets("成绩单").[a1].Resize(d.Count * shtc + t, 26) = ar2
End Sub

jhhkh

djyjysxxs 发表于 2012-1-8 16:50
用了字典，请引用：
Sub test()
Dim d As New Dictionary, ar1(), ar2(), artmp(), sht As Worksheet

能帮忙做个文件让我测试一下，本人对VBA才入门，对字典不懂。
我测试没成功。

djyjysxxs

不晓得字典，那就改一下：
Sub test()
Dim d , ar1(), ar2(), artmp(), sht As Worksheet
Set d = CreateObject("scripting.Dictionary")
shtc = Worksheets.Count
ReDim ar2(1 To 30000, 1 To 26)
artmp = Sheet1.[a1:y1].Value
For Each sht In Worksheets
   If sht.Name <> "成绩单" Then
      i% = sht.[a65536].End(xlUp).Row
      ar1 = sht.Range("a2:y" & i).Value
      t = t% + 1
      For i = 1 To UBound(ar1)
        If Not d.Exists(ar1(i, 1)) Then d(ar1(i, 1)) = d.Count * shtc + 1
        For i2 = 1 To 25
           If t = 1 Then ar2(d(ar1(i, 1)), i2) = artmp(1, i2)
           ar2(d(ar1(i, 1)) + t, i2) = ar1(i, i2)
        Next
        ar2(d(ar1(i, 1)) + t, 26) = sht.Name
      Next
   End If
Next
Sheets("成绩单").Cells.Clear
Sheets("成绩单").[a1].Resize(d.Count * shtc + t, 26) = ar2
End Sub

jhhkh

djyjysxxs 发表于 2012-1-8 17:18
不晓得字典，那就改一下：
Sub test()
Dim d , ar1(), ar2(), artmp(), sht As Worksheet

此贴不给最佳答案给谁？！可以说太完美了！速度快，又用不着考虑人名或分数的顺序！
有两个问题：
1.考号本来是文本格式但在成绩单中变成了数值型了，有没有办法变成文本格式
2.高难度（我这么认为，嘻嘻），现在如果第一张成绩表中如果有一人没参加考试，本张表中就没有他的名字和成绩，经测试在成绩单中就没有这名学生的全部成绩，这与实际不符的，能否这样：保留他参加考试的成绩

djyjysxxs

那就改一下
Sub test()
Dim d, ar1(), ar2(), artmp(), sht As Worksheet
Set d = CreateObject("scripting.Dictionary")
shtc = Worksheets.Count
ReDim ar2(1 To 30000, 1 To 26)
artmp = Sheet1.[a1:y1].Value
For Each sht In Worksheets
   If sht.Name <> "成绩单" Then
      i% = sht.[a65536].End(xlUp).Row
      ar1 = sht.Range("a2:y" & i).Value
      t = t% + 1
      For i = 1 To UBound(ar1)
        If Not d.Exists(ar1(i, 1)) Then d(ar1(i, 1)) = d.Count * shtc + 1
        For i2 = 1 To 25
           If ar2(d(ar1(i, 1)), i2) = "" Then ar2(d(ar1(i, 1)), i2) = artmp(1, i2)
           ar2(d(ar1(i, 1)) + t, i2) = ar1(i, i2)
        Next
        ar2(d(ar1(i, 1)) + t, 26) = sht.Name
      Next
   End If
Next
Sheets("成绩单").Cells.Clear
Sheets("成绩单").[a1].Resize(d.Count * shtc + t).NumberFormatLocal = "@"
Sheets("成绩单").[a1].Resize(d.Count * shtc + t, 26) = ar2
End Sub

jhhkh

djyjysxxs 发表于 2012-1-9 01:51
那就改一下
Sub test()
Dim d, ar1(), ar2(), artmp(), sht As Worksheet

我说的不是这个学生成绩为空，而是当某个学生在第一张表中没有出现，例如在第一次考试由于没参加所以就没有他的姓名，而后三场考试都参加了，或者某个学生是后转学来的因些在第一张表中当然不能出现，根据程序测试的结果，他的后面的成绩是不能出现的，根本没有他后来的的考试成绩。
有办法吗？谢谢！

djyjysxxs

jhhkh 发表于 2012-1-9 13:04
我说的不是这个学生成绩为空，而是当某个学生在第一张表中没有出现，例如在第一次考试由于没参加所以就没 ...

你仔细看了没有？说了改嘛肯定就有了三。
你所说的情况，到最尾巴上去看看他在不在嘛