11月13/14日 零基础学Excel VBA 300集Office 2010微视频教程
10月18/19日 7天Excel脱白 高效办公必会的Office实战技巧
10月23/24日 财务会计玩转Excel 网易云课堂-Excel数据透视表应用大全
Excel数据处理与分析实战技巧第1季
查看: 295|回复: 8

VBA实战开发第四期-第十三课作业贴

[复制链接]
发表于 2017-9-24 09:22:03 | 显示全部楼层 |阅读模式
VBA实战开发第四期-第十三课作业贴
回复

使用道具 举报

发表于 2017-9-24 09:46:11 | 显示全部楼层
实战作业13:(2017-09-24 安冬-UID:1700565)
  1. '作业1:按书名升序、金额降序排序各记录
  2. Sub Ex1_SQL_OrderBy()
  3.     Dim conn As New ADODB.Connection, sql$, i&
  4.     Sheet5.Activate
  5.     [A1].CurrentRegion.ClearContents
  6.     conn.Provider = "Microsoft.Ace.Oledb.12.0"
  7.     conn.Properties("Extended Properties") = "Excel 12.0"
  8.     conn.Properties("Data Source") = ThisWorkbook.Path & "\图书销售.xlsx"
  9.     conn.Open
  10.         sql = "SELECT A.*, 数量*单价 AS 总价 FROM [图书销售$] A ORDER BY 书名, 数量*单价 DESC"
  11.         For i = 1 To conn.Execute(sql).Fields.Count
  12.             Cells(1, i) = conn.Execute(sql).Fields(i - 1).Name
  13.         Next i
  14.         [A2].CopyFromRecordset conn.Execute(sql)
  15.     conn.Close
  16.     Set conn = Nothing
  17.     [A1].CurrentRegion.EntireColumn.AutoFit
  18. End Sub
复制代码
  1. '作业2:按书名升序、金额降序排序各记录
  2. Sub Ex2_SQLInAccess()
  3.     Dim conn As Object
  4.     Set conn = CreateObject("ADODB.Connection")
  5.     Sheet6.Activate
  6.     ActiveSheet.UsedRange.ClearContents
  7.     conn.Provider = "Microsoft.Ace.Oledb.12.0"
  8.     conn.Open "Data Source=" & ThisWorkbook.Path & "\学校管理.accdb"
  9.         '2.1. 查询Student表中的所有记录的Sname、Ssex和Class列:
  10.         [A1:C1] = Array("姓名", "性别", "班级")
  11.         [A2].CopyFromRecordset conn.Execute("SELECT Sname, Ssex, Class FROM Student")
  12.         '2.2. 查询教师所有的单位即不重复的Depart列:
  13.         [E1] = "系名称"
  14.         [E2].CopyFromRecordset conn.Execute("SELECT DISTINCT Depart FROM Teacher")
  15.         '2.3. 查询 Student 表的所有记录:
  16.         [G1:K1] = Array("学号", "姓名", "性别", "出生日期", "班级")
  17.         [G2].CopyFromRecordset conn.Execute("SELECT * FROM Student")
  18.         '2.4. 查询Score表中成绩在60到80之间的所有记录:
  19.         [M1:O1] = Array("学号", "课程号", "分数")
  20.         [M2].CopyFromRecordset conn.Execute("SELECT * FROM Score WHERE Degree BETWEEN 60 AND 80")
  21.     conn.Close
  22.     Set conn = Nothing
  23.     ActiveSheet.UsedRange.EntireColumn.AutoFit
  24. End Sub
复制代码


回复 支持 反对

使用道具 举报

发表于 2017-9-24 14:45:07 | 显示全部楼层
本帖最后由 cynthiashi 于 2017-9-24 14:46 编辑

Sub 图书销售1() '正式课13作业1,记录按书名升序及金额降序排序


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;Extendedproperties=" _
   & "excel 12.0;data source=" & ThisWorkbook.FullName
   sql = "select A.*, 数量 * 单价 as 金额 from [图书销售$] as A order by 书名 asc,数量 * 单价 desc"
   Set rst = conn.Execute(sql)
   Worksheets("sheet1").[a2].CopyFromRecordset rst
   rst.Close
   conn.Close
    Set rst = Nothing
   Set conn = Nothing

End Sub




Sub 图书销售2() '正式课13作业1,金额大于500记录


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;Extendedproperties=" _
    & "excel 12.0;data source="& ThisWorkbook.FullName
   sql = "select A.*, 数量 * 单价 as 金额 from [图书销售$] as A where 数量 * 单价 > 500"
   Set rst = conn.Execute(sql)
   Worksheets("sheet2").[a2].CopyFromRecordset rst
   rst.Close
   conn.Close
   Set rst = Nothing
   Set conn = Nothing

End Sub


Sub 学校管理1() '正式课13作业2,查询student表中的所有记录的sname,ssexclass


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;data source=" _
   & ThisWorkbook.Path & "\学校管理.accdb"
   sql = "select Sname,Ssex,Class from student"
   Set rst = conn.Execute(sql)
   Worksheets.Add after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).[a1].Resize(1, 3) =Array("Sname", "Ssex", "Class")
   Worksheets(Worksheets.Count).[a2].CopyFromRecordset conn.Execute(sql)
   conn.Close
   Set rst = Nothing
   Set conn = Nothing

End Sub




Sub 学校管理2() '正式课13作业2,查询教师所有的单位即不重复的depart


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;data source=" _
   & ThisWorkbook.Path & "\学校管理.accdb"
   sql = "select distinct depart from teacher"
   Set rst = conn.Execute(sql)
   Worksheets.Add after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).[a1].Resize(1, 1) =Array("DEPART")
   Worksheets(Worksheets.Count).[a2].CopyFromRecordset conn.Execute(sql)
   conn.Close
   Set rst = Nothing
   Set conn = Nothing

End Sub





Sub 学校管理3() '正式课13作业2,查询Student表的所有记录


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;data source=" _
   & ThisWorkbook.Path & "\学校管理.accdb"
   sql = "select * from student"
   Set rst = conn.Execute(sql)
   Worksheets.Add after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).[a1].Resize(1, 5) = Array("SNO","SNAME", "SSEX", "SBIRTHDAY", "CLASS")
   Worksheets(Worksheets.Count).[a2].CopyFromRecordset conn.Execute(sql)
   conn.Close
   Set rst = Nothing
   Set conn = Nothing

End Sub




Sub 学校管理4() '正式课13作业2,查询score表中成绩在6080之间的所有记录


   Dim rst As ADODB.Recordset
   Dim sql As String
   Dim conn As New ADODB.Connection
   conn.Open "provider=microsoft.ace.oledb.12.0;data source=" _
   & ThisWorkbook.Path & "\学校管理.accdb"
   sql = "select * from  scorewhere degree between 60 and 80"
   Set rst = conn.Execute(sql)
   Worksheets.Add after:=Worksheets(Worksheets.Count)
   Worksheets(Worksheets.Count).[a1].Resize(1, 3) = Array("SNO","CNO", "DEGREE")
   Worksheets(Worksheets.Count).[a2].CopyFromRecordset conn.Execute(sql)
   conn.Close
   Set rst = Nothing
   Set conn = Nothing

End Sub
回复 支持 反对

使用道具 举报

发表于 2017-9-25 22:03:16 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim conn As New ADODB.Connection, sqlstr As String
  3.     Dim rst As ADODB.Recordset, i As Long
  4.     conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;" _
  5.     & "Data Source=" & ThisWorkbook.Path & "\图书销售.xlsx"
  6.     sqlstr = "select * from [图书销售$] order by 书名 asc,数量* 单价 desc"
  7.     Set rst = conn.Execute(sqlstr)
  8.     With ThisWorkbook.Worksheets("结果")
  9.         For i = 0 To rst.Fields.Count - 1
  10.             .Cells(1, i + 1) = rst.Fields(i).Name
  11.         Next
  12.         ThisWorkbook.Worksheets("结果").Range("a2").CopyFromRecordset rst
  13.     End With
  14.     rst.Close
  15.     Set rst = Nothing
  16.     conn.Close
  17.     Set conn = Nothing
  18. End Sub
复制代码
  1. 作业2 (1)
  2. SELECT SNAME, SSEX,CLASS FROM STUDENT

  3. 作业2 (2)
  4. SELECT DISTINCT DEPART FROM TEACHER

  5. 作业2 (3)
  6. SELECT * FROM STUDENT

  7. 作业2 (4)
  8. SELECT * FROM SCORE WHERE DEGREE BETWEEN 60 AND 80
复制代码


回复 支持 反对

使用道具 举报

发表于 2017-9-25 22:25:30 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim conn As Object:    Set conn = CreateObject("adodb.connection")
  3. '    Dim reco As Object:    Set reco = CreateObject("adodb.recordset")
  4.     Dim sql As String
  5.     conn.Open "provider = microsoft.ace.oledb.12.0;extended properties= excel 12.0;data source =" & ThisWorkbook.FullName
  6.     sql = "select * from [图书销售$] order by 书名, 数量*单价 desc"
  7.     conn.Execute (sql)
  8.     [a2].CopyFromRecordset conn.Execute(sql)
  9.     conn.colse
  10.     Set conn = Nothing
  11. End Sub

  12. Sub 作业2()
  13.     Dim conn As Object:  Set conn = CreateObject("ADODB.connection")
  14.     Dim sql As String, ran As Range
  15.     conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\学校管理.accdb"
  16.     Sheets("sheet2").UsedRange.Clear
  17.    
  18.     'sql 练手题目
  19.     '1.查询Student表中的所有记录的Sname、Ssex和Class列。
  20.     sql = "select sname,ssex,class from student"
  21. '    [a1].Resize(1, 3) = Array("smame", "ssex", "class")
  22.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  23.     ran.CopyFromRecordset conn.execute(sql)
  24.    
  25.     '2 查询教师所有的单位即不重复的Depart列?
  26.     sql = "select distinct depart from teacher"
  27.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  28.     ran = "dapart"
  29.     ran.Offset(1, 0).CopyFromRecordset conn.execute(sql)
  30.    
  31.     '3 查询Student表的所有记录?
  32.     sql = "select * from student"
  33.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  34.     ran.CopyFromRecordset conn.execute(sql)
  35.    
  36.     '4 查询Score表中成绩在60到80之间的所有记录?
  37.     sql = "select * from score where (degree between 60 and 80)"
  38.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  39.     ran.CopyFromRecordset conn.execute(sql)
  40.    
  41.     '5、 查询Score表中成绩为85,86或88的记录。
  42.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  43.     ran.CopyFromRecordset conn.execute("select * from score where (degree=85 or degree=86 or degree=88)")
  44.    
  45.     '6、 查询Student表中“95031”班或性别为“女”的同学记录。
  46.     Set ran = Cells(65516, 1).End(xlUp).Offset(2, 0)
  47.     ran.CopyFromRecordset conn.execute("select * from student where (class='95031' or ssex = '女')")
  48.    
  49.     '7 ? 以Class降序查询Student表的所有记录?
  50.     Set ran = Cells(65516, 1).End(xlUp).Offset(2, 0)
  51.     ran.CopyFromRecordset conn.execute("select * from student order by class desc")
  52.    
  53.     '8 ? 以Cno升序?Degree降序查询Score表的所有记录?
  54.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  55.     ran.CopyFromRecordset conn.execute("select * from score order by cno and degree desc")
  56.     '再往后面暂时不会了
  57. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2017-9-25 22:26:57 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim conn As Object:    Set conn = CreateObject("adodb.connection")
  3. '    Dim reco As Object:    Set reco = CreateObject("adodb.recordset")
  4.     Dim sql As String
  5.     conn.Open "provider = microsoft.ace.oledb.12.0;extended properties= excel 12.0;data source =" & ThisWorkbook.FullName
  6.     sql = "select * from [图书销售$] order by 书名, 数量*单价 desc"
  7.     conn.Execute (sql)
  8.     [a2].CopyFromRecordset conn.Execute(sql)
  9.     conn.colse
  10.     Set conn = Nothing
  11. End Sub

  12. Sub 作业2()
  13.     Dim conn As Object:  Set conn = CreateObject("ADODB.connection")
  14.     Dim sql As String, ran As Range
  15.     conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\学校管理.accdb"
  16.     Sheets("sheet2").UsedRange.Clear
  17.    
  18.     'sql 练手题目
  19.     '1.查询Student表中的所有记录的Sname、Ssex和Class列。
  20.     sql = "select sname,ssex,class from student"
  21. '    [a1].Resize(1, 3) = Array("smame", "ssex", "class")
  22.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  23.     ran.CopyFromRecordset conn.execute(sql)
  24.    
  25.     '2 查询教师所有的单位即不重复的Depart列?
  26.     sql = "select distinct depart from teacher"
  27.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  28.     ran = "dapart"
  29.     ran.Offset(1, 0).CopyFromRecordset conn.execute(sql)
  30.    
  31.     '3 查询Student表的所有记录?
  32.     sql = "select * from student"
  33.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  34.     ran.CopyFromRecordset conn.execute(sql)
  35.    
  36.     '4 查询Score表中成绩在60到80之间的所有记录?
  37.     sql = "select * from score where (degree between 60 and 80)"
  38.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  39.     ran.CopyFromRecordset conn.execute(sql)
  40.    
  41.     '5、 查询Score表中成绩为85,86或88的记录。
  42.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  43.     ran.CopyFromRecordset conn.execute("select * from score where (degree=85 or degree=86 or degree=88)")
  44.    
  45.     '6、 查询Student表中“95031”班或性别为“女”的同学记录。
  46.     Set ran = Cells(65516, 1).End(xlUp).Offset(2, 0)
  47.     ran.CopyFromRecordset conn.execute("select * from student where (class='95031' or ssex = '女')")
  48.    
  49.     '7 ? 以Class降序查询Student表的所有记录?
  50.     Set ran = Cells(65516, 1).End(xlUp).Offset(2, 0)
  51.     ran.CopyFromRecordset conn.execute("select * from student order by class desc")
  52.    
  53.     '8 ? 以Cno升序?Degree降序查询Score表的所有记录?
  54.     Set ran = Cells(65536, 1).End(xlUp).Offset(2, 0)
  55.     ran.CopyFromRecordset conn.execute("select * from score order by cno and degree desc")
  56.     '再往后面暂时不会了

  57.     conn.Close
  58.     set conn = nothing
  59. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2017-9-29 14:25:55 | 显示全部楼层
  1. Sub 作业13_1()
  2. '连接图书销售工作簿的图书销售工作表,将记录按书名(升序),金额(数量×单价)降序排序
  3.     Dim con As Object, rst As Object, sql$, i&
  4.     Set con = CreateObject("adodb.connection")
  5.     Set rst = CreateObject("adodb.recordset")
  6.     Sheets.Add after:=Sheets(Sheets.Count)
  7.     Range("a1").CurrentRegion.ClearContents
  8.      con.Open "Provider=Microsoft.Ace.Oledb.12.0;Extended properties=Excel 12.0;" _
  9.     & "Data Source=" & ThisWorkbook.Path & "\图书销售.xlsx"
  10.     sql = "SELECT a.*, 数量*单价 as 总价 from [图书销售$] a order by 书名, 数量*单价 desc"
  11.     For i = 0 To con.Execute(sql).Fields.Count - 1
  12.         Cells(1, i + 1) = con.Execute(sql).Fields(i).Name
  13.     Next
  14.     Range("a2").CopyFromRecordset con.Execute(sql)
  15.     [a1].CurrentRegion.EntireColumn.AutoFit
  16.     con.Close
  17.     Set con = Nothing
  18.     Set rst = Nothing
  19. End Sub

  20. Sub 作业13_2_1()
  21. '查询student表中的所有记录的sname,ssex和class列
  22.     Dim con As Object, rst As Object, sql$
  23.     Set con = CreateObject("adodb.connection")
  24.     Set rst = CreateObject("adodb.recordset")
  25.    con.Open "provider=microsoft.ace.oledb.12.0;data source=" _
  26.    & ThisWorkbook.Path & "\学校管理.accdb"
  27.    sql = "select Sname,Ssex,Class from student"
  28.     Sheets.Add after:=Sheets(Sheets.Count)
  29.     For i = 0 To con.Execute(sql).Fields.Count - 1
  30.         Cells(1, i + 1) = con.Execute(sql).Fields(i).Name
  31.     Next
  32.    [a2].CopyFromRecordset con.Execute(sql)
  33.    [a1].CurrentRegion.EntireColumn.AutoFit
  34.    con.Close
  35.    Set rst = Nothing
  36.    Set con = Nothing
  37. End Sub

  38. Sub 作业13_2_2()
  39. '查询教师所有的单位即不重复的Depart列
  40.     Dim con As Object, rst As Object, sql$, i&
  41.     Set con = CreateObject("adodb.connection")
  42.     Set rst = CreateObject("adodb.recordset")
  43.    con.Open "provider=microsoft.ace.oledb.12.0;data source=" _
  44.    & ThisWorkbook.Path & "\学校管理.accdb"
  45.    sql = "select distinct depart from teacher"
  46.     Sheets.Add after:=Sheets(Sheets.Count)
  47.     For i = 0 To con.Execute(sql).Fields.Count - 1
  48.         Cells(1, i + 1) = con.Execute(sql).Fields(i).Name
  49.     Next
  50.    [a2].CopyFromRecordset con.Execute(sql)
  51.    [a1].CurrentRegion.EntireColumn.AutoFit
  52.    con.Close
  53.    Set rst = Nothing
  54.    Set con = Nothing
  55. End Sub

  56. Sub 作业13_2_3()
  57. '查询Student表的所有记录
  58.     Dim con As Object, rst As Object, sql$, i&
  59.     Set con = CreateObject("adodb.connection")
  60.     Set rst = CreateObject("adodb.recordset")
  61.    con.Open "provider=microsoft.ace.oledb.12.0;data source=" _
  62.    & ThisWorkbook.Path & "\学校管理.accdb"
  63.    sql = "select * from student"
  64.     Sheets.Add after:=Sheets(Sheets.Count)
  65.     For i = 0 To con.Execute(sql).Fields.Count - 1
  66.         Cells(1, i + 1) = con.Execute(sql).Fields(i).Name
  67.     Next
  68.    [a2].CopyFromRecordset con.Execute(sql)
  69.    [a1].CurrentRegion.EntireColumn.AutoFit
  70.    con.Close
  71.    Set rst = Nothing
  72.    Set con = Nothing
  73. End Sub

  74. Sub 作业13_2_4()
  75. '查询Score表中成绩在60到80之间的所有记录
  76.     Dim con As Object, rst As Object, sql$, i&
  77.     Set con = CreateObject("adodb.connection")
  78.     Set rst = CreateObject("adodb.recordset")
  79.    con.Open "provider=microsoft.ace.oledb.12.0;data source=" _
  80.    & ThisWorkbook.Path & "\学校管理.accdb"
  81.    sql = "select * from score where degree between 60 and 80 "
  82.     Sheets.Add after:=Sheets(Sheets.Count)
  83.     For i = 0 To con.Execute(sql).Fields.Count - 1
  84.         Cells(1, i + 1) = con.Execute(sql).Fields(i).Name
  85.     Next
  86.    [a2].CopyFromRecordset con.Execute(sql)
  87.    [a1].CurrentRegion.EntireColumn.AutoFit
  88.    con.Close
  89.    Set rst = Nothing
  90.    Set con = Nothing
  91. End Sub
复制代码


回复 支持 反对

使用道具 举报

发表于 2017-9-29 22:07:07 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim conn As Object, sql As String, rst As adodb.Recordset
  3.     Set conn = CreateObject("ADODB.Connection")
  4.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;Extended Properties=Excel 12.0; " _
  5.      & "Data Source= " & ThisWorkbook.Path & "\图书销售.xlsx"
  6.     sql = "select  [图书销售$].* ,  数量*单价  as 金额 from [图书销售$] order by 书名 ,性别"
  7.   
  8.     Set rst = conn.Execute(sql)
  9.     Sheet2.[a2].CopyFromRecordset rst
  10.    
  11.    conn.Close
  12.    Set rst = Nothing
  13.    Set conn = Nothing

  14. End Sub
  15. Sub 作业2()
  16.     Dim conn As adodb.Connection, sql As String, rst As adodb.Recordset
  17.     Set conn = CreateObject("ADODB.Connection")
  18.     conn.Open "Provider=Microsoft.Ace.oledb.12.0;Data Source= " _
  19.         & ThisWorkbook.Path & "\学校管理.accdb"
  20.     sql = "select  Sname,Ssex,Class from student"
  21.     Set rst = conn.Execute(sql)
  22.     Sheet3.[a1].Resize(1, 3) = Array("姓名", "性别", "班级")
  23.     Sheet3.[a2].CopyFromRecordset rst
  24.     sql = "select distinct depart from teacher "
  25.     Set rst = conn.Execute(sql)
  26.     Sheet3.[e1] = "老师所在的单位"
  27.     Sheet3.[e2].CopyFromRecordset rst
  28.     '3 查询Student表的所有记录?
  29.     sql = "select * from student "
  30.     Set rst = conn.Execute(sql)
  31.     Sheet3.[g1].Resize(1, 5) = Array("学号", "姓名", "性别", "生日", "班级")
  32.     Sheet3.[g2].CopyFromRecordset rst
  33.     '4 查询Score表中成绩在60到80之间的所有记录?
  34.     sql = "select  * from score where degree between 60 and 80 "
  35.     Set rst = conn.Execute(sql)
  36.     Sheet3.[e10].CopyFromRecordset rst
  37.     conn.Close
  38.     Set conn = Nothing
  39.     Set rst = Nothing
  40.    

  41. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2017-10-9 10:27:38 | 显示全部楼层
国庆期间终于完成练手题目

VBA实战开发第四期_第13课作业_449372956(JSON).zip

52.42 KB, 下载次数: 1

QQ:449372956

回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 入学

本版积分规则

关闭

站长推荐上一条 /2 下一条

快速回复 返回顶部 返回列表