[已解决]如何用VBA进行组合统计及求和

531tommy

需要在D列填充：优秀，良好、中等
判断条件：
1）如果C列求和>250且B列参与人数>3人，则D列填充一班为优秀
2）如果C列求和>250，但参与人数<=3人，则D填充为良好
3）如果C列求和<250,则D填充为中等
评级表.zip (7.48 KB, 下载次数: 11)

2021-9-30 23:52 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

lisongmei

2021-10-1 00:19

1. Option Explicit
   
2. 
   
3. Sub v_v()
   
4. Dim i, k As Integer
   
5. Dim rng As Range
   
6. Dim s As Long
   
7. Range("d2:d10000").ClearContents
   
8. Set rng = Range("a2")
   
9. For i = 2 To Range("a10000").End(xlUp).Row + 1
   
10.     If Range("a" & i).Value = rng.Value Then
    
11.         k = k + 1
    
12.         s = s + Range("c" & i)
    
13.     Else
    
14.         If s > 250 Then
    
15.             If k > 3 Then
    
16.                 Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "优秀"
    
17.             Else
    
18.                 Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "良好"
    
19.             End If
    
20.         Else
    
21.             Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "中等"
    
22.         End If
    
23.         Set rng = Range("a" & i)
    
24.         k = 1
    
25.         s = rng.Offset(0, 2).Value
    
26.     End If
    
27. Next
    
28. End Sub
    

复制代码

跳转到最佳答案楼层

lisongmei

1. Option Explicit
   
2. 
   
3. Sub v_v()
   
4. Dim i, k As Integer
   
5. Dim rng As Range
   
6. Dim s As Long
   
7. Range("d2:d10000").ClearContents
   
8. Set rng = Range("a2")
   
9. For i = 2 To Range("a10000").End(xlUp).Row + 1
   
10.     If Range("a" & i).Value = rng.Value Then
    
11.         k = k + 1
    
12.         s = s + Range("c" & i)
    
13.     Else
    
14.         If s > 250 Then
    
15.             If k > 3 Then
    
16.                 Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "优秀"
    
17.             Else
    
18.                 Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "良好"
    
19.             End If
    
20.         Else
    
21.             Range(Cells(rng.Row, "D"), Cells(i - 1, "d")).Value = "中等"
    
22.         End If
    
23.         Set rng = Range("a" & i)
    
24.         k = 1
    
25.         s = rng.Offset(0, 2).Value
    
26.     End If
    
27. Next
    
28. End Sub
    

复制代码

531tommy

lisongmei 发表于 2021-10-1 00:19

很感谢，这个可以使用了

心正意诚身修

1. Sub 等级()
   
2. Dim ARR, BRR(), I As Integer, J As Integer, K As Integer, L As Integer, C As Integer, S As Integer
   
3. ARR = Range("A1").CurrentRegion
   
4. I = UBound(ARR)
   
5. ReDim BRR(1 To I - 1)
   
6. Range("D2:D" & I).Clear
   
7. For J = 2 To I
   
8. C = 0
   
9. S = 0
   
10.     For K = 2 To I
    
11.         If ARR(J, 1) = ARR(K, 1) Then
    
12.             C = C + 1
    
13.             S = S + ARR(K, 3)
    
14.         End If
    
15.     Next
    
16.     L = L + 1
    
17.     If S > 250 And C >= 3 Then
    
18.         BRR(L) = "优秀"
    
19.     ElseIf S > 250 And C < 3 Then
    
20.         BRR(L) = "良好"
    
21.     Else
    
22.         BRR(L) = "中等"
    
23.     End If
    
24. Next
    
25. Range("D2").Resize(L, 1) = Application.Transpose(BRR)
    
26. End Sub
    

复制代码

我也是个新手。拿来练习一下。感觉这个运行是比较写法应该是比较 慢的。欢迎各位老师指正。

zaalex

Sub test()
Dim m As Integer, n As Integer
For i = 2 To 16
    m = Application.WorksheetFunction.SumIf(Range("a2:a16"), Range("a" & i), Range("c2:c16"))
    n = Application.WorksheetFunction.CountIf(Range("a2:a16"), Range("a" & i))
    If m > 250 And n > 3 Then
        Range("e" & i) = "优秀"
    ElseIf m > 250 And n < 3 Then
        Range("e" & i) = "良好"
     ElseIf m < 250 Then
        Range("e" & i) = "中等"
    End If
Next
End Sub