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

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

[复制链接]
发表于 2017-9-19 16:42:58 | 显示全部楼层 |阅读模式
VBA实战开发第四期-第十二课作业贴
回复

使用道具 举报

发表于 2017-9-19 23:42:20 | 显示全部楼层
实战作业12:(2017-09-19 安冬-UID:1700565)
  1. Option Explicit
  2. '作业1:添加两条记录
  3. Sub Ex1_SQL_Insert()
  4.     Dim conn As New ADODB.Connection
  5.     Dim connStr$, sql$
  6.     connStr = "Provider=Microsoft.Ace.Oledb.12.0;" & _
  7.               "Data Source=" & ThisWorkbook.Path & "\水浒英雄.accdb"
  8.     conn.Open ConnectionString:=connStr
  9.         sql = "DELETE FROM 成绩表1 WHERE 学号 = '0154' OR 学号 = '0155'"
  10.         conn.Execute sql
  11.         sql = "INSERT INTO 成绩表1 VALUES ('1', '0154', '两头蛇', 60, 75, 38, 65, 40, 51, 329)"
  12.         conn.Execute sql
  13.         sql = "INSERT INTO 成绩表1 VALUES ('1', '0155', '双头蝎', 81 ,32, 90, 85, 76, 91, 455)"
  14.         conn.Execute sql
  15.     conn.Close
  16.     Set conn = Nothing
  17. End Sub
复制代码
  1. '作业2:按科目成绩分班
  2. Sub Ex2_SQL_SortClass()
  3.     Dim conn As ADODB.Connection
  4.     Dim connStr$, sql$
  5.     Set conn = CreateObject("ADODB.Connection")
  6.     connStr = "Provider=Microsoft.Ace.Oledb.12.0;" & _
  7.               "Data Source=" & ThisWorkbook.Path & "\水浒英雄.accdb"
  8.     conn.Open connStr
  9.         sql = "UPDATE 成绩表2 SET 班别 = '2' WHERE 班别 = '1' AND 语文 < 60"
  10.         conn.Execute sql
  11.         sql = "UPDATE 成绩表2 SET 班别 = '3' WHERE 班别 = '1' AND 数学 < 60"
  12.         conn.Execute sql
  13.         sql = "UPDATE 成绩表2 SET 班别 = '4' WHERE 班别 = '1' AND 英语 < 60"
  14.         conn.Execute sql
  15.         sql = "UPDATE 成绩表2 SET 班别 = '5' WHERE 班别 = '1' AND 物理 < 60"
  16.         conn.Execute sql
  17.         sql = "UPDATE 成绩表2 SET 班别 = '6' WHERE 班别 = '1' AND 化学 < 60"
  18.         conn.Execute sql
  19.         sql = "UPDATE 成绩表2 SET 班别 = '7' WHERE 班别 = '1' AND 生物 < 60"
  20.         conn.Execute sql
  21.     conn.Close
  22.     Set conn = Nothing
  23. End Sub
复制代码
  1. '作业3:剔除年龄超过40岁的男员工及非职员级员工
  2. Sub Ex3_SQL_Revolution()
  3.     Dim conn As New ADODB.Connection
  4.     Dim connStr$, sql$
  5.     connStr = "Provider=Microsoft.Ace.Oledb.12.0;" & _
  6.               "Data Source=" & ThisWorkbook.Path & "\员工数据库.accdb"
  7.     conn.Open connStr
  8.         sql = "DELETE FROM ttest WHERE 职务<>'职员' OR (年龄>40 AND 性别='男')"
  9.         conn.Execute sql
  10.         sql = "SELECT * FROM ttest"
  11.         Sheet1.[A1].CopyFromRecordset conn.Execute(sql)
  12.     conn.Close
  13.     Set conn = Nothing
  14. End Sub
复制代码


回复 支持 反对

使用道具 举报

发表于 2017-9-21 15:29:03 | 显示全部楼层
本帖最后由 18708693595 于 2017-9-21 17:31 编辑

第一次在VBA中真正意义上使用SQL,代码有点那什么

VBA实战开发第四期_第12课作业_449372956(JSON)_作业1和作业2.zip

111.02 KB, 下载次数: 3

QQ:449372956

回复 支持 反对

使用道具 举报

发表于 2017-9-21 20:53:54 | 显示全部楼层
Sub 水浒学生() '正式课12作业1

    Dim conn As ADODB.Connection, sql As String
    Set conn = New ADODB.Connection
    conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\水浒学生.accdb"
    sql = "insert into 成绩表(班别,学号,姓名,语文,数学,英语,物理,化学,生物,总分) values('1','0154','两头蛇',60,75,38,65,40,51,329)"
    conn.Execute sql
    sql = "insert into 成绩表(班别,学号,姓名,语文,数学,英语,物理,化学,生物,总分) values('1','0155','双头蝎',81,32,90,85,76,91,455)"
    conn.Execute sql
    conn.Close
    Set conn = Nothing
   
End Sub


Sub 更新班别() '正式课12作业2

    Dim conn As ADODB.Connection, sql As String
    Set conn = New ADODB.Connection
    conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\水浒学生.accdb"
    sql = "update 成绩表副本 set 班别 = '2' where 语文<60 and 班别 = '1'"
    conn.Execute sql
    sql = "update 成绩表副本 set 班别 = '3' where 数学<60 and 班别 = '1'"
    conn.Execute sql
    sql = "update 成绩表副本 set 班别 = '4' where 英语<60 and 班别 = '1'"
    conn.Execute sql
    sql = "update 成绩表副本 set 班别 = '5' where 物理<60 and 班别 = '1'"
    conn.Execute sql
    sql = "update 成绩表副本 set 班别 = '6' where 化学<60 and 班别 = '1'"
    conn.Execute sql
    sql = "update 成绩表副本 set 班别 = '7' where 生物<60 and 班别 = '1'"
    conn.Execute sql
    conn.Close
    Set conn = Nothing
   
End Sub


Sub 员工数据库() '正式课12作业3

    Dim conn As ADODB.Connection
    Dim sql As String
    Set conn = New ADODB.Connection
    conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\正式课12员工数据库.accdb"
    sql = " delete from ttest where (年龄>40 and 性别 = '男') or 职务 = '主管'"
    conn.Execute sql
    conn.Close
    Set conn = Nothing
   
End Sub
回复 支持 反对

使用道具 举报

发表于 2017-9-23 16:18:44 | 显示全部楼层
本帖最后由 chenglian99 于 2017-9-24 11:21 编辑
  1. Sub 作业第1大题第2小题()
  2.     Dim conn As Object:  Set conn = CreateObject("ADODB.connection")    '引用对象创建一个连接
  3.     Dim sql As String
  4.     conn.Open "provider = microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\水浒成绩.accdb"    '打开access数据库文件连接(看后面,有开必有关)
  5.     sql = "Insert into 成绩表 (班别,学号,姓名,语文,数学,英语,物理,化学,生物,总分) values ('1','0154','两头蛇',60,75,38,65,40,51,329)"   '写sql语句
  6.     conn.Execute sql    '执行sql
  7.     conn.Execute "insert into 成绩表 values('1','0155','双头蝎',81,32,90,82,76,91,455)" '直接执行
  8.     conn.Close '关闭连接
  9.     Set conn = Nothing  '清空对象释放内存
  10. End Sub
  11. '=========================================================================================

  12. Sub 作业2()
  13.     Dim conn As Object:    Set conn = CreateObject("adodb.connection") '引用对象创建一个连接
  14.     Dim sql As String, i As Long, arr
  15.     arr = Array("语文", "数学", "英语", "物理", "化学", "生物")
  16.     conn.Open "provider = microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\水浒成绩.accdb" '打开access数据库文件连接(看后面,有开必有关)   
  17.     For i = 2 To 7
  18.         sql = "update 成绩表2 set 班别= " & i & " where 班别= 1 and " & arr(i - 2) & "< 60" '写sql语句
  19.         conn.Execute sql    '执行sql
  20.     Next
  21.     conn.Close  '关闭连接
  22.     Set conn = Nothing  '释放内存
  23. End Sub
复制代码
Sub 作业3()
    Dim conn As Object: Set conn = CreateObject("adodb.connection")
    conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\员工数据库.accdb"
    conn.Execute " delete from ttest where 职务 = '主管' or 年龄 > 40"
    conn.Close
    Set conn = Nothing
End Sub

回复 支持 反对

使用道具 举报

发表于 2017-9-25 06:54:43 | 显示全部楼层
  1. Sub 作业1()
  2.     Dim conn As New ADODB.Connection, sql As String
  3.     conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\水浒学生.accdb"
  4.     sql = "Insert Into 成绩表 values('1','0154','两头蛇',60,75,38,65,40,51,329)"
  5.     conn.Execute sql
  6.     sql = "Insert Into 成绩表 values('1','0155','双头蝎',81 , 32,  90,  85,  76,  91,455)"
  7.     conn.Execute sql
  8.     conn.Close
  9.     Set conn = Nothing
  10. End Sub

  11. Sub 作业2()
  12.     Dim conn As New ADODB.Connection, sql As String
  13.     conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\水浒学生.accdb"
  14.     sql = "select * into 新表 from 成绩表"
  15.     conn.Execute sql
  16.     sql = "Update 新表 set 班别 = '2' where 语文 < 60"
  17.     conn.Execute sql
  18.     sql = "Update 新表 set 班别 = '3' where 数学 < 60 And 班别 = '1'"
  19.     conn.Execute sql
  20.     sql = "Update 新表 set 班别 = '4' where 英语 < 60 And 班别 = '1'"
  21.     conn.Execute sql
  22.     sql = "Update 新表 set 班别 = '5' where 物理 < 60 And 班别 = '1'"
  23.     conn.Execute sql
  24.     sql = "Update 新表 set 班别 = '6' where 化学 < 60 And 班别 = '1'"
  25.     conn.Execute sql
  26.     sql = "Update 新表 set 班别 = '7' where 生物 < 60 And 班别 = '1'"
  27.     conn.Execute sql
  28.     conn.Close
  29.     Set conn = Nothing
  30. End Sub

  31. Sub 作业3()
  32.     Dim conn As New ADODB.Connection, sql As String
  33.     conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & "\员工数据库.accdb"
  34.     sql = "delete from ttest where 职务='主管' or (年龄>40 and 性别='男')"  '删除主管和40岁以上男性
  35.     conn.Execute sql
  36.     conn.Close
  37.     Set conn = Nothing
  38. End Sub
复制代码


回复 支持 反对

使用道具 举报

发表于 2017-9-29 15:32:38 | 显示全部楼层
本帖最后由 行动的蜗牛 于 2017-9-29 17:12 编辑
  1. <div class="blockcode"><blockquote>Sub 作业12_1()
  2. '建立水浒数据库,用程序ADODB.Connection 对象连接该数据库
  3. '在成绩表总插入两条记录
  4.     Dim conn As Object, sql$
  5.     Set conn = CreateObject("adodb.connection")
  6.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
  7.     ThisWorkbook.Path & "\水浒英雄数据库.accdb"
  8.     sql = "insert into 成绩表 values ('1', '0154', '两头蛇', 60, 75, 38, 65, 40, 51, 329)"
  9.     conn.Execute sql
  10.     sql = "insert into 成绩表 values ('1', '0155', '双头蝎', 81 ,32, 90, 85, 76, 91, 455)"
  11.     conn.Execute sql
  12.     conn.Close
  13.     Set conn = Nothing
  14. End Sub

  15. Sub 作业12_2()
  16. '把有成绩不及格的学生分为1班
  17.     Dim conn As Object, sql$
  18.     Set conn = CreateObject("adodb.connection")
  19.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
  20.     ThisWorkbook.Path & "\水浒英雄数据库.accdb"
  21.         sql = "update 成绩表1 set 班别 = '2' where 班别 = '1' and 语文 < 60"
  22.         conn.Execute sql
  23.         sql = "update 成绩表1 set 班别 = '3' where 班别 = '1' and 数学 < 60"
  24.         conn.Execute sql
  25.         sql = "update 成绩表1 set 班别 = '4' where 班别 = '1' and 英语 < 60"
  26.         conn.Execute sql
  27.         sql = "update 成绩表1 set 班别 = '5' where 班别 = '1' and 物理 < 60"
  28.         conn.Execute sql
  29.         sql = "update 成绩表1 set 班别 = '6' where 班别 = '1' and 化学 < 60"
  30.         conn.Execute sql
  31.         sql = "update 成绩表1 set 班别 = '7' where 班别 = '1' and 生物 < 60"
  32.         conn.Execute sql
  33.     conn.Close
  34.     Set conn = Nothing
  35. End Sub

  36. Sub 作业12_3()
  37. '剔除年龄超过40岁的男员工和职位不是职员的员工
  38.     Dim conn As Object, sql$
  39.     Set conn = CreateObject("adodb.connection")
  40.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
  41.     ThisWorkbook.Path & "\员工数据库.accdb"
  42.     sql = "delete from ttest where  (年龄>40 and 性别='男') or 职务<>'职员' "
  43.     conn.Execute sql
  44.     sql = "select * from ttest"
  45.     Sheets.Add after:=Sheets(Sheets.Count)
  46.     [a1].CopyFromRecordset conn.Execute(sql)
  47.     [a1].CurrentRegion.EntireColumn.AutoFit
  48.     conn.Close
  49.     Set conn = Nothing
  50. End Sub
复制代码

回复 支持 反对

使用道具 举报

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

本版积分规则

关闭

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

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