求助下分数段人数统计问题，谢谢

lktqj

大神，我想把总成绩在分数段统计这个表中按照各班各科分数段人数统计出来。
刚开始学VBA，也借鉴了论坛里面大神的例子，学艺不精，把大神的例子修改后始终出错，故来求助，感谢
重新放上了打包文件和用的大神的例子

opel-wong

分数段统计表，是空的。
格式是怎样的？字段？模拟数据？

lktqj

opel-wong 发表于 2022-4-14 22:10
分数段统计表，是空的。
格式是怎样的？字段？模拟数据？

感谢，我重新上传个附件，清大神看看，我希望是能随意增减班级数目和科目，不知道行不。我这再上传个附件，我忘记是哪个大神做的了，在此感谢，用这个代码我那表中时，我一直修改不对
希望能做的像做这个附件的模式一样。

liulang0808

建议楼主结合附件，将需求具体描述清楚，并模拟结果
目前分段怎么分，结果格式怎样，全都没有，没法猜结果的

lktqj

liulang0808 发表于 2022-4-15 08:07
建议楼主结合附件，将需求具体描述清楚，并模拟结果
目前分段怎么分，结果格式怎样，全都没有，没法猜结果 ...

谢谢版主关注，我利用分段统计的例子在自行修改后始终要出问题，还请版主指点下。附上样式在各科分段统计压缩包里面和我用的分段统计的例子。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Application.ScreenUpdating = False
   
6.   Application.DisplayAlerts = False
   
7.   Set d = CreateObject("scripting.dictionary")
   
8.   With Worksheets("文科")
   
9.     .AutoFilterMode = False
   
10.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
11.     c = .Cells(2, .Columns.Count).End(xlToLeft).Column
    
12.     arr = .Range("a2").Resize(r - 1, c)
    
13.   End With
    
14.   ls = 17
    
15.   For j = 5 To UBound(arr, 2)
    
16.     If InStr("语数英政史地生化", arr(1, j)) <> 0 Then
    
17.       Set d(arr(1, j)) = CreateObject("scripting.dictionary")
    
18.       For i = 2 To UBound(arr)
    
19.         If Not d(arr(1, j)).exists(arr(i, 2)) Then
    
20.           ReDim brr(1 To ls)
    
21.           brr(1) = arr(i, 2)
    
22.         Else
    
23.           brr = d(arr(1, j))(arr(i, 2))
    
24.         End If
    
25.         If Len(arr(i, j)) <> 0 Then
    
26.           n = Application.Match(arr(i, j), Array(0, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, 130, 140))
    
27.           If Not IsError(n) Then
    
28.             n = 17 - n
    
29.             brr(n) = brr(n) + 1
    
30.           End If
    
31.           brr(ls) = brr(ls) + 1
    
32.         End If
    
33.         d(arr(1, j))(arr(i, 2)) = brr
    
34.       Next
    
35.     End If
    
36.   Next
    
37.   With Worksheets("分数段统计")
    
38.     .Cells.Clear
    
39.     With .Range("a1")
    
40.       .Value = "各分数段各班人数分科统计表"
    
41.       .Resize(1, ls).Merge
    
42.       With .Font
    
43.         .Name = "微软雅黑"
    
44.         .Size = 18
    
45.       End With
    
46.     End With
    
47.     r1 = 2
    
48.     For Each aa In d.keys
    
49.       .Cells(r1, 1) = aa
    
50.       With .Cells(r1 + 1, 1).Resize(1, ls)
    
51.         .NumberFormatLocal = "@"
    
52.         .Value = Array("班级", "140以上", "130-140", "120-130", "110-120", "100-110", "90-100", "80-90", "70-80", "60-70", "50-60", "40-50", "30-40", "20-30", "10-20", "0-10", "实考人数")
    
53.       End With
    
54.       m = 0
    
55.       ReDim crr(1 To d(aa).Count, 1 To ls)
    
56.       For Each bb In d(aa).keys
    
57.         brr = d(aa)(bb)
    
58.         m = m + 1
    
59.         For j = 1 To UBound(brr)
    
60.           crr(m, j) = brr(j)
    
61.         Next
    
62.       Next
    
63.       .Cells(r1 + 2, 1).Resize(UBound(crr), UBound(crr, 2)) = crr
    
64.       .Cells(r1 + 2, 1).Resize(UBound(crr), UBound(crr, 2)).Sort key1:=.Cells(r1 + 2, 1), order1:=xlAscending, Header:=xlNo
    
65.       With .Cells(r1 + 1, 1).Resize(1 + UBound(crr), UBound(crr, 2))
    
66.         .Borders.LineStyle = xlContinuous
    
67.         With .Font
    
68.           .Name = "微软雅黑"
    
69.           .Size = 11
    
70.         End With
    
71.       End With
    
72.       r1 = r1 + 2 + UBound(crr) + 1
    
73.     Next
    
74.     With .UsedRange
    
75.       .HorizontalAlignment = xlCenter
    
76.       .VerticalAlignment = xlCenter
    
77.     End With
    
78.     .Columns(1).Resize(, ls).AutoFit
    
79.   End With
    
80. End Sub
    

复制代码

chxw68

详见附件。

lktqj

chxw68 发表于 2022-4-15 09:45
详见附件。

感谢感谢，代码我正在学习，有些地方还不是很清楚，慢慢学。
另外，我想问下，像是政史地满分都是100，满分750，如何更改呢,？

chxw68

lktqj 发表于 2022-4-15 09:59
感谢感谢，代码我正在学习，有些地方还不是很清楚，慢慢学。
另外，我想问下，像是政史地满分都是100， ...

你说怎么更改呢？

lktqj

chxw68 发表于 2022-4-15 10:03
你说怎么更改呢？

我想的是语数英是150分的满分，分数段可以不变。政史地三科满分100，分数段就从100开始，而不是150开始。还有个总成绩的统计，满分750，可以分成650以上，650-600,600-550，依次下去，最后一个200以下。我看你的代码里面用了循环，是不是我这样的分类不能用循环？