求助高手实现类似数据透视表的功能

戎马书生222

chxw68 发表于 2024-6-6 15:46
楼主模拟结果不正确吧！50名一个名次段，那么每个名次段人数都应该是50人左右。

期待大侠的设计。新的回复在19楼

魂断蓝桥

戎马书生222 发表于 2024-6-11 09:29
期待大侠的设计。新的回复在19楼

大侠谈不上

aa.rar (191.72 KB, 下载次数: 9)

2024-6-11 14:20 上传

点击文件名下载附件

Option Explicit
Dim cnn As New cConnection
Dim rs As New cRecordset
Sub A()
    Dim arr, BRR, i&, D, S$, M&, j&, TIM
    Set D = CreateObject("Scripting.Dictionary")
    Application.ScreenUpdating = False
    TIM = Timer
    BRR = Sheets("原始考号").Range("A1").CurrentRegion
    For i = 2 To UBound(BRR)
        S = BRR(i, 3) & "|" & BRR(i, 2)
        D(S) = BRR(i, 4) & "|" & BRR(i, 1)
    Next
    With Sheets("原始成绩")
        .[a2:b9999] = ""
        M = .[c9999].End(3).Row
        arr = .Range("a1:d" & M)
        M = UBound(arr)
        For i = 2 To UBound(arr)
            S = arr(i, 3) & "|" & arr(i, 4)
            arr(i, 1) = Split(D(S), "|")(0)
            arr(i, 2) = Split(D(S), "|")(1)
        Next
        .Range("a1").Resize(M, 4) = arr
        Set D = Nothing
    End With
    Call B
    Call c
    Application.ScreenUpdating = True
    MsgBox Format(Timer - TIM, "0.00")
End Sub
Sub B()
    Dim i&, j&, sql$, S$, arr, BRR, M&, crr
    Sheets("原始成绩").Activate
    cnn.CreateNewDB
    sql = "CREATE TABLE T(ID,组合,班级,考号,姓名,科目,成绩)"
    cnn.Execute sql
    cnn.BeginTrans
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
        For j = 5 To 16
            If arr(i, j) <> "" Then
                S = i & ",'" & arr(i, 1) & "'," & arr(i, 2) & "," & arr(i, 3) & ",'" & arr(i, 4) & "','" & arr(1, j) & "'," & arr(i, j)
                sql = "INSERT INTO T VALUES(" & S & ")"
                cnn.Execute sql
            End If
        Next
    Next
    cnn.CommitTrans
    [Q2:AD9999] = ""
    sql = "SELECT RANK() OVER (PARTITION BY 班级,科目 ORDER BY 科目,成绩 DESC)  AS 班名次 FROM T WHERE 科目='总分'  ORDER BY ID"
    rs.OpenRecordset sql, cnn
    Range("Q2").CopyFromRecordset rs.GetADORsFromContent
    sql = "RANK() OVER (PARTITION BY 组合 ORDER BY 组合,成绩 DESC)  AS 组合名次 FROM T  WHERE 科目='总分'  ORDER BY ID"
    Range("R2").CopyFromRecordset rs.GetADORsFromContent
    sql = "SELECT RANK() OVER ( ORDER BY 成绩 DESC)  AS 校名次 FROM T WHERE 科目='总分'  ORDER BY ID"
    Range("S2").CopyFromRecordset rs.GetADORsFromContent
    arr = Range("a1").CurrentRegion
    BRR = Array("语文", "数学", "英语", "日语", "西语", "物理", "化学", "生物", "政治", "历史", "地理")
    For i = 0 To UBound(BRR)
        sql = "SELECT ID,RANK() OVER (PARTITION BY 班级 ORDER BY 班级,成绩 DESC)  AS 班名次,科目" _
        & " FROM T WHERE 科目='" & BRR(i) & "'"
        rs.OpenRecordset sql, cnn
        crr = rs.GetRows
        For M = 0 To UBound(crr, 2)
            arr(crr(0, M), i + 20) = crr(1, M)
        Next
    Next
    Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
End Sub
Sub c()
    Dim i&, j&, sql$, s1$, S$, arr, BRR, T, r As Range, M
    Dim D1, D2, A, B
    Set D1 = CreateObject("Scripting.Dictionary")
    Set D2 = CreateObject("Scripting.Dictionary")
    Sheets("一分一段").Activate
    sql = "CREATE TABLE 区间 (下限,上限,组)"
    cnn.Execute sql
    arr = Sheets("学科普本一本分数线").[a1].CurrentRegion
    sql = "CREATE TABLE 分数线 (科目, 普本线, 高分线)"
    cnn.Execute sql
    cnn.BeginTrans
    For i = 2 To UBound(arr)
        sql = "INSERT INTO 分数线 VALUES('" & arr(i, 1) & "'," & arr(i, 2) & "," & arr(i, 3) & ")"
        cnn.Execute sql
    Next
    For i = 0 To 9
        sql = "INSERT INTO 区间 VALUES(" & i * 10 + 1 & "," & i * 10 + 10 & ",'" & i * 10 + 1 & "-" & i * 10 + 10 & "名')"
        cnn.Execute sql
    Next
    cnn.CommitTrans
    [A3:N9999].Clear
    [A3:N9999] = ""
    Set r = Range("a2:n2")
    sql = "SELECT DISTINCT 班级 FROM T ORDER BY 班级"
    rs.OpenRecordset sql, cnn
    M = rs.RecordCount
    BRR = Array("语文", "数学", "英语", "日语", "西语", "物理", "化学", "生物", "政治", "历史", "地理")
    Application.DisplayAlerts = False
    For i = 0 To UBound(BRR)
        A = [a9999].End(3).Row - 2
        Range("a3").Offset(A, 0).CopyFromRecordset rs.GetADORsFromContent
        B = [a9999].End(3).Row - 2
        Range("a3").Offset(A, 1).Resize(M, 1) = BRR(i)
        Range("B" & A + 3 & ":B" & B + 2).Merge
        B = [a9999].End(3).Row - 2
        Range("a3").Offset(B, 0) = "合计"
        B = [a9999].End(3).Row - 2
        If i < UBound(BRR) Then r.Copy Range("a3").Offset(B, 0)
    Next
    Application.DisplayAlerts = True
    sql = "SELECT 班级,科目,组,COUNT(*) AS 人数 FROM ( SELECT A.*,B.组 FROM (" _
    & "SELECT 班级,科目,成绩,RANK() OVER (PARTITION BY 班级,科目 ORDER BY 班级,科目,成绩 DESC)  AS 班名次 FROM t ) A " _
    & "LEFT JOIN 区间 B ON A.班名次 BETWEEN B.下限 AND B.上限) GROUP BY 班级,科目,组"
    rs.OpenRecordset sql, cnn
    BRR = rs.GetRows
    For j = 0 To UBound(BRR, 2)
        s1 = BRR(0, j) & BRR(1, j) & BRR(2, j)
        D1(s1) = BRR(3, j)
    Next
    sql = "SELECT 班级,科目,SUM(普本人数) as 普本人数,SUM(高分人数) AS 高分人数 FROM (" _
    & " SELECT 班级,T.科目 AS 科目,成绩,成绩>=普本线 AS 普本人数,普本线,成绩>=高分线 AS 高分人数,高分线 FROM T " _
    & " LEFT JOIN 分数线 ON t.科目=分数线.科目) GROUP BY 班级,科目"
    rs.OpenRecordset sql, cnn
    BRR = rs.GetRows
    For j = 0 To UBound(BRR, 2)
        s1 = BRR(0, j) & BRR(1, j)
        D2(s1) = BRR(2, j) & "|" & BRR(3, j)
    Next
    arr = [a1].CurrentRegion
    For i = 3 To UBound(arr)
        If arr(i, 1) <> "合计" And arr(i, 1) <> "班级" Then
            T = arr(i, 2)
            If T <> "" Then
            Else
                arr(i, 2) = arr(i - 1, 2)
                T = arr(i, 2)
            End If
            For j = 3 To UBound(arr, 2) - 1
                If j <= 12 Then
                    S = arr(i, 1) & T & arr(2, j)
                    arr(i, j) = D1(S)
                Else
                    S = arr(i, 1) & T
                    If D2(S) <> "" Then
                        arr(i, j) = Split(D2(S), "|")(0)
                        arr(i, j + 1) = Split(D2(S), "|")(1)
                    End If
                End If
            Next
        End If
    Next
    [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    Set A = Range("A:A").Find("合计")
    For i = A.Row To [a9999].End(3).Row Step M + 2
        Cells(i, 3).Resize(1, 12).FormulaR1C1 = "=SUM(R[-" & M & "]C:R[-1]C)"
    Next
    With Range("a2").CurrentRegion
        .Font.Size = 11
        .Font.Name = "arial"
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    Set rs = Nothing
    Set cnn = Nothing
    Set D1 = Nothing
    Set D2 = Nothing
End Sub

戎马书生222

魂断蓝桥 发表于 2024-6-11 14:20
大侠谈不上

1、工作表“一分一段”，最后缺少了“总分”的统计。
2、数学科目的统计上，应该是：高于数学普本线人数，高于数学一本线人数，其它科目类似
3、排名用美式排名，要不会出现。比如统计1-10名，结果人数会100多人，而不是10人左右。

4、我要想50名一段，一直显示到2000名，需要修改哪里？谢谢

戎马书生222

3190496160 发表于 2024-6-8 08:50

我在后面添加了1-749，想统计一下语文前749名的个数（就相当于统计了语文普本过线数，假设语文普本线的名次是749）。结果什么也没显示。

LJX2008m

戎马书生222 发表于 2024-6-11 09:15
感谢319和魂断蓝桥的劳动。两位大侠的能力太高了。
         319大哥的程序美中不足的是缺少各个 ...

我少数据库？需要安装什么？

3190496160

戎马书生222 发表于 2024-6-11 18:46
我在后面添加了1-749，想统计一下语文前749名的个数（就相当于统计了语文普本过线数，假设语文普本线的名 ...

呵呵，按你在一楼中说的，再结合你的附件，需要统计的名次段应该是互相不存在交集的吧，如果你前面已近有了0-49，你再在后面添加1-749，岂不是互相有交集了吗？那目前的代码就只能统计前面的名次段，后面的名次段肯定就忽略了嘛

魂断蓝桥

aa.rar (197.67 KB, 下载次数: 4)

2024-6-12 10:27 上传

点击文件名下载附件

zpy2

3190496160 发表于 2024-6-12 08:30
呵呵，按你在一楼中说的，再结合你的附件，需要统计的名次段应该是互相不存在交集的吧，如果你前面已近有 ...

我感觉是排序号，并列的 算2行，
姓名 分数 排序号
张三 90 1
李四 90 2


类似这种

https://club.excelhome.net/forum.php?mod=viewthread&tid=1694512&fromguid=hot&extra=&mobile

zpy2

//select * from 考试成绩分段计数 limit 20;
cli_one_dim~考试成绩分段计数~2;
create temp table aa as
select *,rank() over ( partition by 属性 order by cast(数量 as int) desc) 序号 from 考试成绩分段计数union;
create temp table bb as
select *,((序号-1)/50+1)*50 分数段 from aa;
create temp table cc as
select 属性,'_'||分数段 分数段,count(属性) 计数 from bb group by 属性,分数段;
//select * from cc limit 5;
cli_create_two_dim_no_order~cc~分数段~计数;
//select * from cc_two_dim;
create temp table dd as
select *,case  when 数量>普本线 and 数量<高分线  then 1 when 数量>=高分线 then 2 else 3 end 达线
from 考试成绩分段计数union a left join Sheet2 b on a.属性 like b.学科;
create temp table ee as
select 属性,iif(达线=1,'1普本','2一批') type,count(1) 数量 from dd where 达线<3 group by 属性,达线;
cli_create_two_dim~ee~type~数量;
//select * from ee_two_dim;
select * from cc_two_dim join ee_two_dim using(属性);

zpy2

zpy2 发表于 2024-6-12 12:10
//select * from 考试成绩分段计数 limit 20;
cli_one_dim~考试成绩分段计数~2;
create temp table aa as ...

700多人才100多上二本线，一本3个。。。。