A队视频排名如何提升？， - 91新能源电动汽车网

Excel VBA 学生成绩排名（更新）/SQL循环查询/嵌套查询

本文于2023年6月7日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

☆本期内容概要☆

学生成绩排序更新
用户窗体动态添加控件
SQL语句嵌套查询
SQL循环查询写入工作表

大家好，我是冷水泡茶，前几天我们分享了一个论坛网友求助的帖子（Excel VBA 学生成绩排名/班级年级双排名/SQL查询Excel表），当时也没理解清楚楼主的意思，匆匆做了一个“交差”。

今天又去逛EXCELHOME论坛，发现楼主回帖了：

我还是没想通，又做了一版发了上去，就下班了：

但心里还是有点疑惑的，总觉得哪里不对劲。

晚上又上去看了看别人做的，好象是明白了，应该是把所有科目在一定范围内的排名都列出来，于是又着手修改，最终完成：

在这之前，中间还做了一个版本，可以把所有科目包括总分的排名都列出来，但后来又看到楼主要求，有些科目没有成绩，最好能剔除。我想如果在SQL查询中剔除，好象不太方便，后来干脆把所有科目以复选框的形式展示出来，爱选哪科选哪科，全选也行。

老规矩，我们还是要讲一讲设计思路与过程：

1、复选框，我们使用动态添加控件的方法，循环arrSubject数组，把控件命名为“CheckBox”&i，把它的Caption赋值为arrsubject(i)。

2、然后，我们循环arrsubject数组，查询对应科目的排序结果，依次写入“排名”表。

3、在上述循环中，我们判断CheckBox &i 的值，如果勾选了，我们就运行查询，没勾选我们就跳过。

4、执行下来看，速度有点慢。

我们来看一下代码：

1、窗体启动：

窗体启动前是这样的：

Private Sub UserForm_Activate()    Dim iRow As Integer, iCol As Integer    Dim topPos As Integer    Sheets("成绩表").Activate    With ActiveSheet        iRow = .UsedRange.Rows.Count        iCol = .UsedRange.Columns.Count        For i = 4 To iCol            If Cells(1, i) <> "" Then                ReDim Preserve arrSubject(k)                arrSubject(k) = Cells(1, i)                k = k + 1            End If        Next    End With    leftPos = Me.LbRankBasis.Left + 10  ' 复选框的左侧位置    topPos = Me.LbRankBasis.Top + Me.LbRankBasis.Height + 10 ' 复选框的顶部位置    For i = LBound(arrSubject) To UBound(arrSubject)        '在指定位置插入复选框        Me.Controls.Add "Forms.CheckBox.1", "CheckBox" & i        '设置复选框的位置和属性        With Me.Controls("CheckBox" & i)            .Left = leftPos            .Top = topPos            .Width = 40            .Height = 20            .Caption = arrSubject(i)            .Value = True        End With        '更新位置        If (i + 1) Mod 4 = 0 Then            '换行            leftPos = Me.LbRankBasis.Left + 10            topPos = topPos + 20        Else            '同行下一个位置            leftPos = leftPos + 40        End If    Next    ReDim arrNumber(iRow - 2)    For i = 0 To iRow - 2        arrNumber(i) = i + 1    Next    Me.CombBegin.List = arrNumber    Me.CombEnd.List = arrNumber    Me.CombType.List = Array("班级", "年级")    Sheets("排名").ActivateEnd Sub

代码解析：

（1）把成绩表的第4列到最后一列表头装入数组，这是科目

（2）接下来循环arrSubject数组，动态添加复选框控件，这里我们注意一下控件的位置排列问题。

2、确定按钮，进行排名：

Private Sub CmdRank_Click()    Dim conn As Object    Dim rs As Object    Dim strSQL As String    Dim destSheet As Worksheet    Dim rankSheet As Worksheet    Dim i As Long    Dim dataFile As String    Dim RankingBasis As String    Dim rng As Range    Dim iCtrl As Control    ThisWorkbook.Activate    If Me.CombEnd = "" Or Me.CombBegin > Me.CombEnd Then        MsgBox "请正确输入排名数字！"        Exit Sub    End If    dataFile = ThisWorkbook.FullName    '设置数据库连接字符串    connString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataFile & ";Extended Properties=""Excel 12.0;HDR=Yes;"""    Sheets("排名").Cells.Clear        '连接到数据源    Set conn = CreateObject("ADODB.Connection")    conn.Open connString    For i = 0 To UBound(arrSubject)        If Controls("CheckBox" & i).Value = True Then            strSQL = "SELECT 学号, 姓名, 班别, 语文, 数学, 英语, 政治, 物理, 化学, 历史, 地理, 生物, 体育, 总分, " & _                "(SELECT COUNT(*) + 1 FROM <成绩表$> AS B WHERE B." & arrSubject(i) & " > A." & arrSubject(i) & " AND B.班别 = A.班别) AS 班内排名, " & _                "(SELECT COUNT(*) + 1 FROM <成绩表$> AS C WHERE C." & arrSubject(i) & " > A." & arrSubject(i) & ") AS 年级排名 " & _                "FROM <成绩表$> AS A " & _                "ORDER BY 班别 ASC, " & arrSubject(i) & " DESC"            If Me.CombType <> "年级" Then                strSQL = "SELECT 学号, 姓名, 班别,'" & arrSubject(i) & "' as 科目, " & arrSubject(i) _                & " as 成绩,班内排名,年级排名  from (" & strSQL & ") where 班内排名>=" & Me.CombBegin & " and 班内排名<=" & Me.CombEnd                strSQL = "select * from (" & strSQL & ")  order by 班内排名,成绩 DESC "            Else                strSQL = "SELECT 学号, 姓名, 班别,'" & arrSubject(i) & "' as 科目," & arrSubject(i) _                & " as 成绩,班内排名,年级排名  from (" & strSQL & ") where 年级排名>=" & Me.CombBegin & " and 年级排名<=" & Me.CombEnd                strSQL = "select * from (" & strSQL & ")  order by 班内排名,成绩 DESC "            End If            Set rs = conn.Execute(strSQL)            '将查询结果写入 "排名" 工作表            If i = 0 Then                For j = 1 To rs.Fields.Count                    Sheets("排名").Cells(1, j).Value = rs.Fields(j - 1).Name                Next            End If            iRow = Sheets("排名").UsedRange.Rows.Count + 1            Sheets("排名").Range("A" & iRow).CopyFromRecordset rs        End If    Next    '关闭连接和清理资源    rs.Close    conn.Close    Set rs = Nothing    Set conn = Nothing    Unload MeEnd Sub

代码解析：

1、建立数据查询连接

2、循环arrSubject，每个科目都排名依据进行排名查询，如果对应的CheckBox&i的值为True，则进行查询。

3、构建查询语句，我们有前面的基础，这次稍加修改，把查询依据（前版叫rankingBasis）改为数组的值。前面我们是写入一张表，然后再查询这张表的，我们这次改为直接在查询结果中再查询，就是所谓的嵌套查询。

4、这里我们把arrsubject(i)对应的科目分数查询出来，字段重命名为“成绩"。SQL语句是：“ Select “ & arrsubject(i) & ”as 成绩“

5、我们还要增加一个字段“科目”，它的值为arrsubject(i)的值。SQL语句为：“SELECT ‘” & arrsubject(i) & "' as 科目”，注意与上面的区别，这里在arrsubject(i)前后加了一个单引号，它就变成了一个值，而不是一个字段名。

6、执行查询，把结果写入工作表。这里我们在写表头的时候，判断一下i如果等于0就写入表头，否则就不写入，也就是只写一次。当然重复写也不影响结果。

7、这里要依次把每次查询结果写入工作表，所以每次取得已使用的最后一行加一行作为写入开始位置。

基本就这些，代码本身并不复杂，有点绕人的是SQL查询语句，比较费脑筋，另外，前面有些定义的变量这次没用到，也没有删除，随他去了。

好，今天就到这吧，欢迎点赞、留言、分享，谢谢大家，我们下期再会。

☆猜你喜欢☆

Excel VBA 电子发票管理助手