统计单科成绩并判断总成绩是否合格

yuhan4488

每个学生从科目1到科目5最多有5个成绩，成绩分为A、B、C、D4档。
如果某个学生成绩累计达到CCC或者CD或者DD，则判为“不合格”。
请各位老师赐教

cidanji

dambcer

搞个公式就行了哇

shiruiqiang

c1分，d2分。
大于等于3分就不合格

Qs18

1. Sub qs()
   
2. Dim arr, i
   
3. With Sheet1
   
4. b = [{"CCC","CD","DC","DD"}]
   
5. arr = .Range("b2:f" & .Cells(Rows.Count, 2).End(xlUp).Row)
   
6. ReDim brr(1 To UBound(arr), 1 To 1)
   
7.     For i = 1 To UBound(arr)
   
8.         brr(i, 1) = "合格"
   
9.        a = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Application.Index(arr, i, 0)))
   
10.         a1 = VBA.Filter(a, "A", False)
    
11.         a1 = VBA.Filter(a1, "B", False)
    
12.         t = Join(a1, "")
    
13.         For Each bb In b
    
14.             If InStr(t, bb) Then
    
15.             brr(i, 1) = "不合格"
    
16.             Exit For
    
17.             End If
    
18.         Next bb
    
19.         t = ""
    
20.     Next
    
21. .[g2].Resize(UBound(arr), 1) = brr
    
22. End With
    
23. End Sub
    

复制代码

Qs18

试试..........

Qs18

试试...........

xyxcc177

其实就是两种情况，一个“D”或三个“C”

张小生

1. Sub mytest()
   
2. Dim br(1 To 5), ar, cr, dr As String
   
3. Dim x%, y%, m%, n%, j%, a%, b%
   
4. ar = Range("b2:f" & Range("a60000").End(xlUp).Row)
   
5. ReDim cr(1 To UBound(ar), 1 To 1)
   
6. For x = 1 To UBound(ar, 1)
   
7.     For y = 1 To UBound(ar, 2)
   
8.         br(y) = ar(x, y)
   
9.     Next y
   
10.     For m = 1 To 4
    
11.         For n = m + 1 To 5
    
12.             If br(m) > br(n) Then
    
13.                 temp = br(m): br(m) = br(n): br(n) = temp
    
14.             End If
    
15.         Next n
    
16.     Next m
    
17.     dr = Join(br, "")
    
18.     j = InStr(dr, "CCC"): a = InStr(dr, "CD"): b = InStr(dr, "DD")
    
19.     If j > 0 Or a > 0 Or b > 0 Then
    
20.         cr(x, 1) = "不合格"
    
21.     Else
    
22.         cr(x, 1) = "合格"
    
23.     End If
    
24. Next x
    
25. Range("g2").Resize(UBound(cr), 1) = cr
    
26. End Sub

复制代码

张小生

Sub mytest()
Dim br(1 To 5), ar, cr, dr As String
Dim x%, y%, m%, n%, j%, a%, b%
ar = Range("b2:f" & Range("a60000").End(xlUp).Row)
ReDim cr(1 To UBound(ar), 1 To 1)
For x = 1 To UBound(ar, 1)
    For y = 1 To UBound(ar, 2)
        br(y) = ar(x, y)
    Next y
    For m = 1 To 4
        For n = m + 1 To 5
            If br(m) > br(n) Then
                temp = br(m): br(m) = br(n): br(n) = temp
            End If
        Next n
    Next m
    dr = Join(br, "")
    j = InStr(dr, "CCC"): a = InStr(dr, "CD"): b = InStr(dr, "DD")
    If j > 0 Or a > 0 Or b > 0 Then
        cr(x, 1) = "不合格"
    Else
        cr(x, 1) = "合格"
    End If
Next x
Range("g2").Resize(UBound(cr), 1) = cr
End Sub