excel如何取一组成绩的前15%，中间30%中的最高分与最低分

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, crr()
   
4.   With Worksheets("参数设置")
   
5.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
   
6.     brr = .Range("b1").Resize(2, c - 1)
   
7.   End With
   
8.   For j = 2 To UBound(brr, 2)
   
9.     brr(2, j) = brr(2, j - 1) + brr(2, j)
   
10.   Next
    
11.   With Worksheets("sheet1")
    
12.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
13.     c = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
14.     arr = .Range("a1").Resize(r, c)
    
15.     ReDim zrr(1 To (UBound(arr, 2) - 1) / 2, 1 To UBound(brr, 2) + 1)
    
16.     q = 0
    
17.     For j = 2 To UBound(arr, 2) Step 2
    
18.       q = q + 1
    
19.       zrr(q, 1) = arr(1, j)
    
20.       m = 0
    
21.       For i = 2 To UBound(arr)
    
22.         If Len(arr(i, j)) <> 0 Then
    
23.           m = m + 1
    
24.           ReDim Preserve crr(1 To m)
    
25.           crr(m) = arr(i, j)
    
26.         End If
    
27.       Next
    
28.       rs = UBound(crr)
    
29.       For k = 1 To UBound(brr, 2)
    
30.         zrr(q, k + 1) = Application.Large(crr, rs * brr(2, k))
    
31.       Next
    
32.     Next
    
33.   End With
    
34.   With Worksheets("参数设置")
    
35.     .Select
    
36.     With .Range("a3").Resize(UBound(zrr), UBound(zrr, 2))
    
37.       .Value = zrr
    
38.       .Interior.ColorIndex = 3
    
39.     End With
    
40.   End With
    
41.   
    
42. End Sub
    

复制代码

chxw68

结果在[参数设置]表里第3行以后，其中的数字为各科目各等级的最低分数。

chxw68

详见附件。

zjh200010

谢谢！但好像无法赋分呢？还有打开好，会出现两个工作表。请再帮我看看。再次谢谢

chxw68

zjh200010 发表于 2020-2-1 09:33
谢谢！但好像无法赋分呢？还有打开好，会出现两个工作表。请再帮我看看。再次谢谢

出现两个窗口关掉一个就行了。这个代码只供参考，你要求的是计算出各等级的最高分和最低分，代码已经实现了。你没有提供赋分标准怎么赋分呢？

zjh200010

谢谢！能否做成这样的！再次谢谢！

zjh200010

然后给各科赋分。谢谢

chxw68

zjh200010 发表于 2020-2-1 10:19
然后给各科赋分。谢谢

看你的附件就很随意，不像是真正求助的。只能帮助你到这里了，等其他人来帮你吧。

zjh200010

这是高二选科，有的学生选政治、有的选生物，有的两科都选，所得到的结果