[已解决]面试考试题，用VBA编写代码完成数据的统计

MEMORY婷婷婷

昨天面试库存分析，部门经理给出的考题，求助！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-6-4 16:44

请看附件。

跳转到最佳答案楼层

roych

可以用系统自带的函数吗（例如，Application.WorksheetFunction.CountIf）？
如果可以，应该不太难。
如果不可以只能用数组（或者字典）或者ADO了？

MEMORY婷婷婷

roych 发表于 2015-6-4 14:07
可以用系统自带的函数吗（例如，Application.WorksheetFunction.CountIf）？
如果可以，应该不太难。
如果 ...

没有特别要求，只要能解出来就好，明天早上就要交了，求教。

grf1973

1. Sub go()
   
2.     brr = [b2:g10]
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(brr)    '每个运动员在结果数组中的位置
   
5.         d(brr(i, 1)) = i
   
6.     Next
   
7.     arr = Range("j1:L" & [j65536].End(3).Row)
   
8.     For i = 2 To UBound(arr)
   
9.         x = arr(i, 1): cj = arr(i, 3)
   
10.         If d(x) > 0 Then
    
11.             p = d(x)       '找到运动员在结果数组中的位置
    
12.             If cj = "缺席" Then brr(p, 3) = "Y"
    
13.             If Val(cj) > 0 Then    '如果有成绩
    
14.                 brr(p, 2) = brr(p, 2) + 1      '场数+1
    
15.                 brr(p, 6) = brr(p, 6) + cj      '总成绩
    
16.                 If Len(brr(p, 4)) = 0 Then      '最高分
    
17.                     brr(p, 4) = cj
    
18.                 Else
    
19.                     If brr(p, 4) < cj Then brr(p, 4) = cj
    
20.                 End If
    
21.                 If Len(brr(p, 5)) = 0 Then    '最低分
    
22.                     brr(p, 5) = cj
    
23.                 Else
    
24.                     If brr(p, 5) > cj Then brr(p, 5) = cj
    
25.                 End If
    
26.             End If
    
27.         End If
    
28.     Next
    
29.    
    
30.     For i = 2 To UBound(brr)
    
31.         If brr(i, 2) > 0 Then
    
32.             If brr(i, 3) = "" Then brr(i, 3) = "N"       '无缺席者
    
33.             If brr(i, 2) > 2 Then         '参加场数大于2，减最高分最低分求平均
    
34.                 brr(i, 6) = (brr(i, 6) - brr(i, 4) - brr(i, 5)) / (brr(i, 2) - 2)
    
35.             Else            '参加场数<=2，直接求平均
    
36.                 brr(i, 6) = brr(i, 6) / brr(i, 2)
    
37.             End If
    
38.         End If
    
39.     Next
    
40.     [b2:g10] = brr
    
41.                
    
42. End Sub
    

复制代码

grf1973

请看附件。

ivanyangjm

学习了