怎么改sql语句

wxxydl

现有一张成绩表，要求计算每个班  每学科的有效分人数？

具体要求见附件？

qdtzq

...............

baofa2

1. Option Explicit
   
2. 
   
3. Sub test0()
   
4.   Dim ar, Conn As Object, rs As Object, i As Long
   
5.   Dim strSQL As String, SQL As String, strConn As String
   
6.   Dim tab_ As String, class_ As String, pivot_ As String
   
7.   
   
8.   Set Conn = CreateObject("ADODB.Connection")
   
9.   If Application.Version < 12 Then
   
10.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
    
11.   Else
    
12.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
    
13.   End If
    
14.   Conn.Open strConn & ThisWorkbook.FullName
    
15.   
    
16.   With Sheet1
    
17.     tab_ = .Name & "$" & .Range("A1").CurrentRegion.Address(0, 0)
    
18.     class_ = .Range("A1").Value
    
19.     ar = .Range("M1").CurrentRegion.Resize(2).Value
    
20.   End With
    
21.   
    
22.   SQL = "SELECT " & class_ & ",'-ar(1,i)' AS 科目 ,-ar(1,i) AS 成绩 FROM [" & tab_ & "] WHERE -ar(1,i)>=-ar(2,i)"
    
23.   For i = 2 To UBound(ar, 2)
    
24.     strSQL = strSQL & " UNION ALL " & Replace(Replace(SQL, "-ar(1,i)", ar(1, i)), "-ar(2,i)", ar(2, i))
    
25.     pivot_ = pivot_ & ",'" & ar(1, i) & "'"
    
26.   Next
    
27.   strSQL = Mid(strSQL, 12) & Replace(strSQL, class_, "'总计'")
    
28.   
    
29.   strSQL = "TRANSFORM COUNT(成绩) SELECT " & class_ & " FROM (" & strSQL & ") GROUP BY " & class_ & " PIVOT 科目 IN (" & Mid(pivot_, 2) & ")"
    
30.   Set rs = Conn.Execute(strSQL)
    
31.   
    
32.   With Sheet1.Range("M1")
    
33.     .CurrentRegion.Offset(2).ClearContents
    
34.     For i = 0 To rs.Fields.Count - 1
    
35.       .Offset(, i) = rs.Fields(i).Name
    
36.     Next
    
37.     .Offset(2).CopyFromRecordset rs
    
38.   End With
    
39.   
    
40.   rs.Close
    
41.   Set rs = Nothing
    
42.   Conn.Close
    
43.   Set Conn = Nothing
    
44.   Beep
    
45. End Sub
    

复制代码

limonet

关键字：union all

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    Arr = Range("N1:U2")
    For i = 1 To UBound(Arr, 2)
        StrSQL = StrSQL & " Union All Select 班级,'" & Arr(1, i) & "' as 科目,Count(*) as 计数 From [理科$A:J] Where " & Arr(1, i) & ">=" & Arr(2, i) & " Group By 班级" _
        & " Union All Select '总计','" & Arr(1, i) & "' as 科目,Sum(计数) as 计数 From (Select 班级,'" & Arr(1, i) & "' as 科目,Count(*) as 计数 From [理科$A:J] Where " & Arr(1, i) & ">=" & Arr(2, i) & " Group By 班级)"
    Next i
    StrSQL = "TransForm Sum(计数) Select 班级 From (" & Mid(StrSQL, 12) & ") Group By 班级 Pivot 科目 In('语文','英语','数学','物理','化学','生物','理综','总分')"
    Range("M14").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

wxxydl

谢谢两位高手