如何进行分类统计？

lion118

ykcbf1100 发表于 2024-7-17 11:50
如果有这种情况，那应该是数据本身的问题。

您好，可能我表述的不清楚，我的意思是总分11000是个大前提，在这个大前提下，再统计总分11000以前的学生里单科名次11000以前有多少，同样总分19000的前提下，单科19000的人数有多少。统计单科人数时都需要考虑是否满足总分11000和19000这个大前提。例如，1班总分11000一共18人，其他单科人数在这个大前提先，最多也就18人，不会比这个多，只能少。

lion118

kyxfyzg 发表于 2024-7-17 14:17
Sub a()
Dim d As New Dictionary, dd As New Dictionary
With Sheets("原始数据")

您好，您这个代码运行不了。谢谢。

longwin

看看是不是这个意思。已更新，先看总名次，总名次满足再看单科名次也要满足。

ykcbf1100

lion118 发表于 2024-7-17 17:01
您好，可能我表述的不清楚，我的意思是总分11000是个大前提，在这个大前提下，再统计总分11000以前的学生 ...

懂你的意思了，改好了。。。

ykcbf1100

加个总分判断。

1. Sub ykcbf()   '//2024.7.17   人数统计
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     Set d1 = CreateObject("Scripting.Dictionary")
   
5.     num1 = 11000: num2 = 19000
   
6.     With Sheets("原始数据")
   
7.         r = .Cells(Rows.Count, 2).End(3).Row
   
8.         c = .UsedRange.Columns.Count
   
9.         arr = .[a1].Resize(r, c)
   
10.     End With
    
11.     For i = 2 To UBound(arr)
    
12.         If arr(i, 4) <= num1 Then
    
13.             For j = 3 To UBound(arr, 2) Step 2
    
14.                 s = arr(i, 2) & "|" & arr(1, j)
    
15.                 If arr(i, j + 1) <= num1 Then
    
16.                     d(s) = d(s) + 1
    
17.                 End If
    
18.                 If arr(i, j + 1) <= num2 Then
    
19.                     d1(s) = d1(s) + 1
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("统计结果")
    
25.         r = .Cells(Rows.Count, 2).End(3).Row
    
26.         c = .UsedRange.Columns.Count
    
27.         arr = .[a1].Resize(r, c)
    
28.         For i = 2 To UBound(arr) Step 2
    
29.             For j = 3 To UBound(arr, 2)
    
30.                 s = arr(i, 1) & "|" & arr(1, j)
    
31.                 arr(i, j) = d(s)
    
32.                 arr(i + 1, j) = d1(s)
    
33.             Next
    
34.         Next
    
35.         .[a1].Resize(r, c) = arr
    
36.     End With
    
37.     Set d = Nothing
    
38.     Set d1 = Nothing
    
39.     Application.ScreenUpdating = True
    
40.     MsgBox "OK！"
    
41. End Sub
    
42. 
    

复制代码

lion118

longwin 发表于 2024-7-17 18:08
看看是不是这个意思。已更新，先看总名次，总名次满足再看单科名次也要满足。

对，就是这个意思，非常感谢！

lion118

ykcbf1100 发表于 2024-7-17 19:13
懂你的意思了，改好了。。。

您好，请问更改在哪里，我想研究一下，谢谢。

ykcbf1100

lion118 发表于 2024-7-17 19:36
您好，请问更改在哪里，我想研究一下，谢谢。

忘了上传附件了。已上传。

lion118

ykcbf1100 发表于 2024-7-17 19:49
忘了上传附件了。已上传。

收到，我看前面longwin这位老师上传的也能实现这个功能，他的还可以自动生成统计结果模板，并且可以根据需要修改需要统计的名次，请问，您这个要是实现的话需要加哪些代码。谢谢。

ykcbf1100

lion118 发表于 2024-7-17 20:06
收到，我看前面longwin这位老师上传的也能实现这个功能，他的还可以自动生成统计结果模板，并且可以根据 ...

你用他的代码就行了。忽略我的代码。