求助考试三率的计算

chxw68

详见附件。

chxw68

优生统计代码

1. Sub test3()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   Set d1 = CreateObject("scripting.dictionary")
   
9.   With Worksheets("起点优生统计表")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     c = .Cells(3, .Columns.Count).End(xlToLeft).Column
    
12.     .Range("d4").Resize(r - 3, c - 3).ClearContents
    
13.     brr = .Range("a4").Resize(r - 3, c)
    
14.     For i = 1 To UBound(brr)
    
15.       xm = brr(i, 1) & "+" & brr(i, 2) & "+" & brr(i, 3)
    
16.       d(xm) = i
    
17.     Next
    
18.   End With
    
19.   With Worksheets("起点成绩")
    
20.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
21.     arr = .Range("a2:q" & r)
    
22.   End With
    
23.   For i = 1 To UBound(arr)
    
24.     xm = arr(i, 1) & "+" & arr(i, 2) & "+" & arr(i, 3)
    
25.     If d.exists(xm) Then
    
26.       m = d(xm)
    
27.       For j = 10 To 13
    
28.         If j = 13 Then
    
29.           n = 4
    
30.         Else
    
31.           n = j * 6 - 50
    
32.         End If
    
33.         If Len(arr(i, j)) <> 0 Then
    
34.           If arr(i, j) <= 50 Then
    
35.             brr(m, n + 1) = brr(m, n + 1) + 1
    
36.           ElseIf arr(i, j) <= 100 Then
    
37.             brr(m, n + 2) = brr(m, n + 2) + 1
    
38.           End If
    
39.           If arr(i, j) <= 100 Then
    
40.             brr(m, n + 3) = brr(m, n + 3) + 1
    
41.           End If
    
42.           If arr(i, j) >= 151 And arr(i, j) <= 200 Then
    
43.             brr(m, n + 4) = brr(m, n + 4) + 1
    
44.           End If
    
45.           If arr(i, j) >= 101 And arr(i, j) <= 200 Then
    
46.             brr(m, n + 5) = brr(m, n + 5) + 1
    
47.           End If
    
48.         End If
    
49.       Next
    
50.     End If
    
51.   Next
    
52.   With Worksheets("起点优生统计表")
    
53.     .Range("a4").Resize(UBound(brr), UBound(brr, 2)) = brr
    
54.   End With
    
55. End Sub
    

复制代码

chxw68

详见附件。

chxw68

学困生统计代码

1. Sub test4()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   Set d1 = CreateObject("scripting.dictionary")
   
9.   With Worksheets("起点学困生统计表")
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     c = .Cells(3, .Columns.Count).End(xlToLeft).Column
    
12.     .Range("d4").Resize(r - 3, c - 3).ClearContents
    
13.     brr = .Range("a4").Resize(r - 3, c)
    
14.     For i = 1 To UBound(brr)
    
15.       xm = brr(i, 1) & "+" & brr(i, 2) & "+" & brr(i, 3)
    
16.       d(xm) = i
    
17.     Next
    
18.   End With
    
19.   With Worksheets("起点成绩")
    
20.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
21.     arr = .Range("a2:q" & r)
    
22.   End With
    
23.   For i = 1 To UBound(arr)
    
24.     xm = arr(i, 1) & "+" & arr(i, 2) & "+" & arr(i, 3)
    
25.     If d.exists(xm) Then
    
26.       m = d(xm)
    
27.       For j = 14 To 17
    
28.         If j = 17 Then
    
29.           n = 4
    
30.         Else
    
31.           n = j * 3 - 35
    
32.         End If
    
33.         If Len(arr(i, j)) <> 0 Then
    
34.           If arr(i, j) <= 100 Then
    
35.             brr(m, n + 1) = brr(m, n + 1) + 1
    
36.           End If
    
37.           If arr(i, j) <= 200 Then
    
38.             brr(m, n + 2) = brr(m, n + 2) + 1
    
39.           End If
    
40.         End If
    
41.       Next
    
42.     End If
    
43.   Next
    
44.   With Worksheets("起点学困生统计表")
    
45.     .Range("a4").Resize(UBound(brr), UBound(brr, 2)) = brr
    
46.   End With
    
47. End Sub
    
48. 
    

复制代码

chxw68

4问代码全部写完了。

stoncold

你这表使用VBA会运行速度快，不然全不格式，那计算量太大了。使用vba来运行的话，代码比较长，暂时没空去写。不过运行起来的速度肯定比使用公式快多了。

stoncold

chxw68 发表于 2018-10-26 16:44
4问代码全部写完了。

刚才下载看了一下，好厉害啊，这么短时间就写出来。不过有个问题一共7096名学生，语文中最低分是1分有3名，也排到1127名。这个有点不科学吧。应该是排到7094名吧。
不过先下载来看看代码，学习学习一下。我开始想到的实现方式跟你的有点不一样，不过用VBA的话速度肯定比使用公式的快多了。

stoncold

chxw68 发表于 2018-10-26 16:44
4问代码全部写完了。

另外的话，就是那个一校区的语文中100分和99.6分都是第一名。这个统计排名是有点问题吧。
刚开了第一段的部分代码。真牛，值得学习，不管对错，但是里面很多操作值得学习观摩。刚自学VBA还不到1个月，还在学习中。

chxw68

stoncold 发表于 2018-10-26 17:22
另外的话，就是那个一校区的语文中100分和99.6分都是第一名。这个统计排名是有点问题吧。
刚开了第一段 ...

以后多加指导！学了1个月就这么牛！

chxw68

stoncold 发表于 2018-10-26 17:22
另外的话，就是那个一校区的语文中100分和99.6分都是第一名。这个统计排名是有点问题吧。
刚开了第一段 ...

我也在学习，有错误在所难免。