如何根据原始表成绩关键列班级和成绩生成类型和需补考科目及目标表各班名单和统计表

yzyyyyyyy · 发表于 2023-4-13 17:12

原始表：关键列班级，地理，生物成绩，班级乱序。若成绩为空，须补考；若某一科为D，该学科需补考。不用E、F列列数据，原始表中原无，直接程序生成。

目标表：按班级顺序生成班级需补考列表。是否可另生成一个目标表的文本文件，方便粘贴。
统计表：各班级补考，按地理,生物，地理，生物三种类型统计，及合计。

蓝桥玄霜 · 发表于 2023-4-13 19:07

地理1完成的基础上完成地理2，

chxw68 · 发表于 2023-4-13 19:24

Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("原始表")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:f" & r)
End With
For i = 1 To UBound(arr)
If Len(arr(i, 6)) <> 0 Then
If Not d.exists(arr(i, 1)) Then
Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
End If
d(arr(i, 1))(i) = Empty
End If
Next
With Worksheets("目标表")
.Cells.Clear
r = 1
For k = 1 To 5
If d.exists(k) Then
ReDim brr(1 To d(k).Count, 1 To 7)
m = 0
For Each bb In d(k).keys
m = m + 1
brr(m, 1) = m
For j = 1 To UBound(arr, 2)
brr(m, j + 1) = arr(bb, j)
Next
Next
With .Cells(r, 1).Resize(1, 2)
.Value = Array(k & "班", UBound(brr) & "人")
With .Font
.Name = "微软雅黑"
.Size = 10
End With
End With
.Cells(r + 1, 1).Resize(1, 7) = Array("序号", "班级", "姓名", "地理", "生物", "类型", "需补考科目")
.Cells(r + 2, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
With .Cells(r + 1, 1).Resize(1 + UBound(brr), UBound(brr, 2))
.Borders.LineStyle = xlContinuous
With .Font
.Name = "微软雅黑"
.Size = 10
End With
End With
r = r + 2 + UBound(brr) + 1
End If
Next
With .UsedRange
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
End Sub

复制代码

chxw68 · 发表于 2023-4-13 19:33

复制代码

chxw68 · 发表于 2023-4-13 19:34

详见附件。

清风竹- · 发表于 2023-4-13 20:31

参与一下。

		自动登录	找回密码
密码			免费注册

[求助] 如何根据原始表成绩关键列班级和成绩生成类型和需补考科目及目标表各班名单和统计表