学生考试成绩合并求助

chxw68

参与练习。

ykcbf1100

练习一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.22
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     Set sh = ThisWorkbook.Sheets("总计")
   
6.     a = [{"A","B","C","D","E"}]
   
7.     b = [{1,2,3,4,5}]
   
8.     For i = 1 To UBound(a)
   
9.         d1(a(i)) = b(i)
   
10.     Next
    
11.     For Each sht In Sheets
    
12.         If sht.Name <> sh.Name Then
    
13.             arr = sht.UsedRange
    
14.             For i = 2 To UBound(arr)
    
15.                 For j = 3 To UBound(arr, 2)
    
16.                     If arr(i, j) <> Empty Then
    
17.                         s = arr(i, 2) & "|" & arr(1, j)
    
18.                         If Not d.exists(s) Then
    
19.                             d(s) = d1(arr(i, j))
    
20.                         Else
    
21.                             d(s) = IIf(d(s) > d1(arr(i, j)), d1(arr(i, j)), d(s))
    
22.                         End If
    
23.                     End If
    
24.                 Next
    
25.             Next
    
26.         End If
    
27.     Next
    
28.     With sh
    
29.         arr = .UsedRange
    
30.         For i = 2 To UBound(arr)
    
31.             For j = 3 To UBound(arr, 2)
    
32.                 s = arr(i, 2) & "|" & arr(1, j)
    
33.                 If d.exists(s) Then
    
34.                     arr(i, j) = a(d(s))
    
35.                 Else
    
36.                     arr(i, j) = ""
    
37.                 End If
    
38.             Next
    
39.         Next
    
40.         .UsedRange = arr
    
41.     End With
    
42.     Set d = Nothing
    
43.     Set d1 = Nothing
    
44.     Application.ScreenUpdating = True
    
45.     MsgBox "OK！"
    
46. End Sub
    
47. 
    

复制代码

cnmlgb9998

用函数，一步到位的事。。。何必那么麻烦。。。。。。。。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br(), i&, j&, r&, k&, wks As Worksheet
   
    Application.ScreenUpdating = False
   
    For Each wks In Worksheets
        If wks.Name Like "第" & "*" & "次" Then
            r = r + 1
            ReDim Preserve br(1 To r)
            br(r) = wks.[A1].CurrentRegion
        End If
    Next
   
    With Worksheets("总计")
        With .[A1].CurrentRegion
            ar = .Value
            For i = 2 To UBound(ar)
                For j = 3 To UBound(ar, 2)
                    ar(i, j) = Empty
                    For k = 1 To UBound(br)
                        If Len(br(k)(i, j)) Then
                            If Len(ar(i, j)) = 0 Then
                                ar(i, j) = br(k)(i, j)
                            Else
                                ar(i, j) = IIf(ar(i, j) > br(k)(i, j), br(k)(i, j), ar(i, j))
                            End If
                        End If
                    Next k
                Next j
            Next i
            .Value = ar
        End With
        .Activate
    End With
        
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

ZZX26262411

初学者第一次参与，还没学过字典，用的最原始方法，
可以无视学号顺序，还可以优化一下无视科目顺序
3次成绩为空，则显示缺考

gaozengxun

在总计工作表C2单元格输入：
=LET(a,{"A";"B";"C";"D";"E"},b,{100;90;80;70;60},SUBSTITUTES(MAX(IFERROR(--SUBSTITUTES(FILTER(VSTACK(第一次:第三次!C$1:C$30),VSTACK(第一次:第三次!$A$1:$A$30)=$A2),a,b),0)),b,a))
向下，向右拉即可。

gaozengxun

请参考
和上面一致

gaozengxun

cnmlgb9998 发表于 2024-11-22 21:08
用函数，一步到位的事。。。何必那么麻烦。。。。。。。。。。

在WPS中应该是
=LET(_a,VSTACK(第一次!$A$1:$K$30,第二次!$A$2:$K$30,第三次!$A$2:$K$30),GROUPBY(TAKE(_a,,2),DROP(_a,,2),LAMBDA(x,INDEX(SORT(x),1)),3,0))
或者
=LET(_a,VSTACK(第一次!$A$1:$K$1,第一次:第三次!$A$2:$K$30),GROUPBY(TAKE(_a,,2),DROP(_a,,2),LAMBDA(x,INDEX(SORT(x),1)),3,0))