16个班能批量实现多个操作

yoshuya

找到了，送花

LMY123

Sub 学习字典_复习ADO()
Dim cnn As Object, rs As Object, i&, SQL$, sh As Worksheet, rng As Range
    Set rng = Rows(1)
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "全体名单" Then sh.Delete
    Next
    Application.DisplayAlerts = True
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider = Microsoft.Ace.Oledb.12.0;Extended Properties =Excel 12.0;Data Source =" & ThisWorkbook.FullName
    SQL = "select distinct 班级 from [全体名单$]"
    Set rs = cnn.Execute(SQL)
    Do Until rs.EOF
        SQL = "select * from [全体名单$] where 班级=" & rs.Fields(0).Value & ""
        With Sheets.Add(After:=Sheets(Sheets.Count))
            .Name = rs.Fields(0).Value
            rng.Copy .[A1]
            .[a2].CopyFromRecordset cnn.Execute(SQL)
        End With
        rs.MoveNext
    Loop
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

yoshuya

LMY123 发表于 2018-9-5 16:09
Sub 学习字典_复习ADO()
Dim cnn As Object, rs As Object, i&, SQL$, sh As Worksheet, rng As Range
   ...

运行出错，但是谢谢您

LMY123

yoshuya 发表于 2018-9-5 16:46
运行出错，但是谢谢您

Sub 学习字典_复习ADO_1楼附件代码参考()
    Dim cnn As Object, rs As Object, i&, SQL$, sh As Worksheet, rng As Range
    Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "全体名单" Then sh.Delete
    Next
    Application.DisplayAlerts = True
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider = Microsoft.Ace.Oledb.12.0;Extended Properties =Excel 12.0;Data Source =" & ThisWorkbook.FullName
    SQL = "select 姓名 as 姓名,性别 AS 性别,语文 AS 语文,数学 AS 数学,英语 AS 英语,总分 AS 总分,考号*1 AS 考号,班级*1 AS 班级 from [全体名单$] ORDER BY 班级*1,考号*1 "
    SQL = "select distinct 班级 from (" & SQL & ") "
    Set rst = cnn.Execute(SQL)
    Do Until rst.EOF
        SQL = "select 姓名,性别,语文,数学,英语,总分,考号,班级 from [全体名单$] where 班级='" & rst.Fields(0).Value & "'"
        Set rs = cnn.Execute(SQL)
        With Sheets.Add(After:=Sheets(Sheets.Count))
            .Name = rst.Fields(0).Value
            i = 0
            For Each Field In rs.Fields
                aa = Field.Name
                [A1].Offset(0, i) = aa
                i = i + 1
            Next
            .[a2].CopyFromRecordset cnn.Execute(SQL)
        End With
        rst.MoveNext
    Loop
    rs.Close
    rst.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

LMY123

yoshuya 发表于 2018-9-5 16:46
运行出错，但是谢谢您

1楼附件代码参考.rar (51.07 KB, 下载次数: 7)

2018-9-5 17:19 上传

点击文件名下载附件