初一年成绩分析

gtbb2002

在褚老师的无偿帮助下，已经完成了第一个科目分析，现在还有其他的不知怎么完成，不过还希望有老师过来看看

有时发晕

全vba的成绩，简直要膜拜啊

小花鹿

还是找褚老师吧，如果觉得不过意，就给点报酬                                                                       

micch

1. Sub NJPM()
   
2.     Dim i%, k%, n%, ks%, js%, s, x
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     ks = InputBox("开始名次:", , 1)
   
5.     js = InputBox("结束名次:", , 50)
   
6.     arr = Sheet2.Range("a3:n" & [d65536].End(3).Row)
   
7.     For i = 1 To UBound(arr)
   
8.         If arr(i, 4) <> "" Then
   
9.             x = 0: s = ""
   
10.             For k = 1 To 13
    
11.                 s = s & "@" & arr(i, k)
    
12.                 If k > 4 And k < 14 Then: x = x + arr(i, k)
    
13.             Next
    
14.             s = s & "@" & arr(i, 5) + arr(i, 6) + arr(i, 7)
    
15.             d(s) = x
    
16.         End If
    
17.     Next
    
18.     ar = d.keys: br = d.items
    
19.     For i = 0 To d.Count - 1
    
20.         For k = i + 1 To d.Count - 1
    
21.             If br(k) > br(i) Then
    
22.                 x = br(i): br(i) = br(k): br(k) = x
    
23.                 s = ar(i): ar(i) = ar(k): ar(k) = s
    
24.             End If
    
25.     Next k, i
    
26.     ReDim brr(d.Count, 15)
    
27.     For i = 0 To d.Count - 1
    
28.         If i > ks - 2 And i < js Then
    
29.             brr(n, 13) = br(i)
    
30.                 For k = 0 To 12
    
31.                     brr(n, k) = Split(ar(i), "@")(k + 1)
    
32.                 Next
    
33.             n = n + 1
    
34.         End If
    
35.     Next
    
36.     Sheet4.[a3].Resize(n, 15) = brr
    
37. End Sub
    
38. 
    

复制代码

成绩排名表，实在是写不动了，前三科排名不想写了，没时间了。

vvw123

可用公式解决

abc123281

路过参与一下
同意三楼的说法
    打开看了一下楼主上传的附件  褚老师的代码  大约300行
别说自己写写  就是照着抄写   少了一两个小时完成不了  
何况之前还需要弄清楚求助者的需求和想要达到的目的  这也需要一些时间吧  
  当然  该代码是否付费  大家也不得而知

abc123281

哦  没太注意  是无偿的帮助  呵呵
向褚老师学习   向褚老师致敬！

yjh_27

自定义排名函数

gtbb2002

yjh_27 发表于 2018-12-31 10:15
自定义排名函数

感恩老师的付出，谢谢了