求平均值

yjh_27

zhaojiaoyang200 发表于 2014-1-22 20:33
我问过老师了，＂缺考＂按0处理．这道题我也想出了解决的办法，但太复杂了．

规则要细化：
1＂缺考＂除了按0处理，是否计入总人数，是否计入去掉的5名
2 去掉的5名：是末5人，还是中国式的末5名次（同分为同一名次）

你的办法说说看。

yjh_27

去掉末5人。
模块2 是通用排序代码

zhaojiaoyang200

yjh_27 发表于 2014-1-23 08:53
规则要细化：
1＂缺考＂除了按0处理，是否计入总人数，是否计入去掉的5名
2 去掉的5名：是末5人，还是中 ...

1.＂缺考＂计入去掉的5名
2.每列排序后，去掉末5人．

zhaojiaoyang200

1. Sub test()
   
2. Dim arr, brr, d, i&, j&, zf$, crr(), drr()
   
3. Application.ScreenUpdating = False
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr = Range("a1").CurrentRegion
   
6. MyRow = UBound(arr)
   
7. ReDim crr(1 To 100, 1 To 11): ReDim drr(1 To 100, 1 To 11)
   
8. For i = 3 To 13
   
9. crr(1, i - 2) = arr(3, i)
   
10. Next
    
11. m = 1
    
12. For i = 4 To MyRow
    
13.   If Not d.Exists(arr(i, 3)) Then
    
14.      m = m + 1
    
15.      d(arr(i, 3)) = m
    
16.      crr(m, 1) = arr(i, 3)
    
17.   End If
    
18. Next
    
19. For j = 4 To 13
    
20.    Cells(3, 3).Resize(MyRow - 2).Copy [p3]
    
21.    Cells(3, j).Resize(MyRow - 2).Copy [q3]
    
22.    Range("p3:q" & MyRow).Sort Key1:=Range("q3"), Order1:=xlDescending, Header:=xlGuess
    
23.    arr = Range("p3:q" & (MyRow - 5))
    
24.    For i = 2 To UBound(arr)
    
25.       crr(d(arr(i, 1)), j - 2) = crr(d(arr(i, 1)), j - 2) + arr(i, 2)
    
26.       drr(d(arr(i, 1)), j - 2) = drr(d(arr(i, 1)), j - 2) + 1
    
27.    Next
    
28. Next
    
29. For i = 2 To m
    
30.    For j = 2 To 11
    
31.      crr(i, j) = crr(i, j) / drr(i, j)
    
32.    Next
    
33. Next
    
34. [p:ac].Clear
    
35. Application.ScreenUpdating = True
    
36. [s3].Resize(m, 11) = crr
    
37. End Sub

复制代码