按学校、年级、班级导出相关数据

TAYM

请朋友们帮助“按学校、年级、班级导出相关数据”

通过AI获取的代码，在运行时出错，请朋友们调试一下

3190496160

拆分为工作簿的代码，论坛多如牛毛，搜搜看看呗

半百

3190496160

成绩.rar (162.96 KB, 下载次数: 29)

2024-7-1 11:01 上传

点击文件名下载附件

limonet

关键字：distinct+into

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant, i%, CS$
    Set Cn = CreateObject("Adodb.Connection")
    CS = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 xml;Data Source="
    Cn.Open CS & ThisWorkbook.FullName
    Arr = Cn.Execute("Select Distinct 学校&'-'&年级&'-'&班级 From [成绩$] Where 学校<>''").GetRows
    For i = 0 To UBound(Arr, 2)
        Cn.Close
        Cn.Open CS & ThisWorkbook.Path & "\" & Arr(0, i) & ".xlsx"
        StrSQL = "Select * Into Sheet1 From [Excel 12.0;DataBase=" & ThisWorkbook.FullName & "].[成绩$] Where 学校&'-'&年级&'-'&班级='" & Arr(0, i) & "'"
        Cn.Execute (StrSQL)
    Next i
End Sub

longwin

参与一下：

TAYM

limonet 发表于 2024-7-1 11:05
关键字：distinct+into

谢谢！请问能不能保留原格式导出?

limonet

TAYM 发表于 2024-7-1 11:27
谢谢！请问能不能保留原格式导出?

用其他老师的代码。

TAYM

limonet 发表于 2024-7-1 11:06
Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant, i%, CS$
    Set Cn = CreateObject("Ad ...

最好是原格式导出