小白模仿大神代码，结果出错，特来求助

dy83797465268

1. Sub 总分统计()
   
2. Dim cnn As Object, strPath As String, str_cnn As String
   
3. Dim strSQL As String, rst As Object
   
4. Sheets("八年总分").Range("A4:AO4").ClearContents
   
5. strPath = ActiveWorkbook.FullName
   
6. 
   
7. Set cnn = CreateObject("adodb.connection")
   
8. If Application.Version < 12 Then
   
9.     str_cnn = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & strPath
   
10. Else
    
11.     str_cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & strPath
    
12. End If
    
13. 
    
14. cnn.Open str_cnn
    
15. strSQL = "Select '慈云中学',count(T.姓名),Sum(T.总分),avg(T.总分),max(T.总分),min(T.总分)," & _
    
16. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=630 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=620 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=610 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=600 ), " & _
    
17. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=590 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=580 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=570 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=560 ), " & _
    
18. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=550 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=540 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=530 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=520 ), " & _
    
19. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=510 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=500 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=490 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=480 ), " & _
    
20. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=470 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=460 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=450 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=440 ), " & _
    
21. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=430 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=420 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=410 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=400 ), " & _
    
22. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=390 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=380 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=370 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=360 ), " & _
    
23. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=350 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=340 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=330 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=320 ), " & _
    
24. "(select count(姓名) from [学生成绩$A3:M]  where 总分>=310 ), (select count(姓名) from [学生成绩$A3:M]  where 总分>=300 ), (select count(姓名) from [学生成绩$A3:M]  where 总分<300 )" & _
    
25. "from [学生成绩$A3:M] as T"
    
26. Debug.Print strSQL
    
27. Set rst = cnn.Execute(strSQL)
    
28. Sheets("八年总分").Cells(4, 1).CopyFromRecordset rst
    
29. 
    
30. MsgBox ("统计完成")
    
31. 
    
32. End Sub
    
33. 
    
34. 
    
35. 
    

复制代码

ykcbf1100

参与一下，把分数段写入Collection集合

ykcbf1100

分数段统计

1. Sub ykcbf()   '//2024.7.18             总分统计
   
2.     Dim c As New Collection
   
3.     With Sheets("学生成绩")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         arr = .[a1].Resize(r, 13)
   
6.         Max = Application.Max(.Cells(4, 13).Resize(r - 3))
   
7.         Min = Application.Min(.Cells(4, 13).Resize(r - 3))
   
8.     End With
   
9.     With Sheets("八年总分")
   
10.         col = .UsedRange.Columns.Count
    
11.         ReDim brr(1 To 100, 1 To col)
    
12.         For j = 7 To col - 1
    
13.             st = Val(Replace(.Cells(3, j), "≥", ""))
    
14.             c.Add st
    
15.         Next
    
16.         On Error Resume Next
    
17.         For i = 4 To UBound(arr)
    
18.             If Val(arr(i, 2)) Then
    
19.                 m = m + 1
    
20.                 For n = 1 To c.Count
    
21.                     brr(1, 6 + n) = brr(1, 6 + n) + IIf(arr(i, 13) >= c(n) And arr(i, 13) < c(n - 1), 1, 0)
    
22.                 Next
    
23.                 brr(1, 7) = brr(1, 7) + IIf(arr(i, 13) >= c(1), 1, 0)
    
24.                 brr(1, 6 + c.Count + 1) = brr(1, 6 + c.Count + 1) + IIf(arr(i, 13) < c(c.Count), 1, 0)
    
25.                 Sum = Sum + arr(i, 13)
    
26.             End If
    
27.         Next
    
28.         brr(1, 1) = arr(4, 1)
    
29.         brr(1, 2) = m
    
30.         brr(1, 3) = Sum
    
31.         brr(1, 4) = Sum / m
    
32.         brr(1, 5) = Max
    
33.         brr(1, 6) = Min
    
34.         .[a4].Resize(1, 41) = brr
    
35.     End With
    
36. End Sub
    

复制代码

今日123

铁马1980 发表于 2024-7-18 11:03
参与一下，重写了

老师这数组用的太好了，精彩啊

Qs18

Sub qs()
Dim arr, brr, i, clm
clm = 6
With Sheet1
Sheet10.Range("b4:ao4") = ""
arr = .Range("a4:m" & .Cells(Rows.Count, 1).End(xlUp).Row)
Sheet10.Cells(4, 3) = Application.Sum(Application.Index(arr, 0, 13))
Sheet10.Cells(4, 4) = Application.Average(Application.Index(arr, 0, 13))
Sheet10.Cells(4, 5) = Application.Max(Application.Index(arr, 0, 13))
Sheet10.Cells(4, 6) = Application.Min(Application.Index(arr, 0, 13))
Sheet10.Cells(4, 2) = UBound(arr)
a = [{630,620,610,600,590,580,570,560,550,540,530,520,510,500,490,480,470,460,450,440,430,420,410,400,390,380,370,360,350,340,330,320,310,300,299.99999}]
For i = 1 To UBound(a)
    clm = clm + 1
    For j = 1 To UBound(arr)
        If i = 1 Then
            If arr(j, 13) >= a(i) Then
                Sheet10.Cells(4, clm) = Sheet10.Cells(4, clm) + 1
            End If
         ElseIf i = UBound(a) Then
            If arr(j, 13) < a(i) Then
            Sheet10.Cells(4, clm) = Sheet10.Cells(4, clm) + 1
            End If
        Else
            If arr(j, 13) < a(i - 1) And arr(j, 13) >= a(i) Then
                Sheet10.Cells(4, clm) = Sheet10.Cells(4, clm) + 1
            End If
        
        End If
   
    Next
Next


End With

End Sub

Qs18

试试.........

Qs18

试试............