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

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

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

使用道具 举报

发表于 2017-9-20 23:19:29 | 显示全部楼层
本帖最后由 抬头苦干 于 2017-9-21 22:04 编辑

实战作业11:(2017-09-20 安冬-UID:1700565)补交
  1. Option Explicit

  2. '作业1:全选源数据并计算总分
  3. Sub Ex1_SQL_SelectAndSum()
  4.     Dim conn As Object
  5.     Set conn = CreateObject("ADODB.Connection")
  6.     Sheets("练习1").Activate
  7.     [F3].CurrentRegion.Clear
  8.     [F3].Resize(1, 6) = Array("班级", "学生编号", "语文", "数学", "英语", "总分")
  9.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;" & _
  10.               "Extended Properties=Excel 12.0; " & _
  11.               "Data Source=" & ThisWorkbook.FullName
  12.         [F4].CopyFromRecordset conn.Execute("SELECT A.*, IIF(ISNULL(语文), 0, 语文)" & _
  13.             "+IIF(ISNULL(数学), 0, 数学)+IIF(ISNULL(英语), 0, 英语) FROM [成绩表$] A")
  14.     conn.Close
  15.     Set conn = Nothing
  16.     With [F4].CurrentRegion
  17.         .Rows(1).Font.Bold = True
  18.         .Borders.LineStyle = xlContinuous
  19.     End With
  20. End Sub
复制代码
  1. '作业2:筛选有缺考科目的记录
  2. Sub Ex2_SQL_SelectAbsent()
  3.     Dim conn As Object
  4.     Set conn = CreateObject("ADODB.Connection")
  5.     Sheets("练习2").Activate
  6.     [F3].CurrentRegion.Clear
  7.     [F3].Resize(1, 5) = Array("班级", "学生编号", "语文", "数学", "英语")
  8.     conn.Open "Provider=Microsoft.Ace.Oledb.12.0;" & _
  9.               "Extended Properties=Excel 12.0;" & _
  10.               "Data Source=" & ThisWorkbook.FullName
  11.         [F4].CopyFromRecordset conn.Execute("SELECT * FROM [成绩表$] WHERE " & _
  12.             "语文 IS NULL OR 数学 IS NULL OR 英语 IS NULL")
  13.     conn.Close
  14.     Set conn = Nothing
  15.     With [F4].CurrentRegion
  16.         .Rows(1).Font.Bold = True
  17.         .Borders.LineStyle = xlContinuous
  18.     End With
  19. End Sub
复制代码
  1. '作业3:各分数段人数统计
  2. Sub Ex3_PivotDIY()
  3.     Dim conn As New ADODB.Connection
  4.     Dim arr, i&, strSQL$
  5.     Sheet1.Activate
  6.     arr = Array("语文", "数学", "英语")
  7.     For i = 0 To UBound(arr)
  8.         arr(i) = _
  9.             "SELECT 班级, '" & arr(i) & "' AS 科目, " & _
  10.                 "IIF(ISNULL(" & arr(i) & "),0," & arr(i) & ") AS 分数, " & _
  11.                 "SWITCH ( " & _
  12.                     arr(i) & " IS NULL, '缺考', " & _
  13.                     arr(i) & "<60, '不及格', " & _
  14.                     arr(i) & "<70, '60-70分', " & _
  15.                     arr(i) & "<80, '70-80分', " & _
  16.                     arr(i) & "<90, '80-90分', " & _
  17.                     arr(i) & "<100, '90-100分', " & _
  18.                     arr(i) & "=100, '满分', " & _
  19.                 ") AS 分段 " & _
  20.             "FROM [" & Sheet4.Name & "$] "
  21.     Next i
  22.     strSQL = Replace(Join(arr, "@"), "@", "UNION ALL ") & " ORDER BY 班级, 科目"
  23.     Erase arr
  24.     With [B21].CurrentRegion
  25.         conn.Open "Provider=Microsoft.Ace.Oledb.12.0;" & _
  26.                   "Extended Properties=Excel 12.0;" & _
  27.                   "Data Source=" & ThisWorkbook.FullName
  28.             .Clear
  29.             [B20].Resize(1, 4) = Array("班级", "科目", "分数", "分段")
  30.             [B21].CopyFromRecordset conn.Execute(strSQL)
  31.         conn.Close
  32.         Set conn = Nothing
  33.         .Borders.LineStyle = xlContinuous
  34.         .Rows(1).Font.Bold = True
  35.         .EntireColumn.AutoFit
  36.     End With
  37.     '最后利用新数据源插入数据透视表,从略
  38. End Sub
复制代码
数透效果图:
第11课作业:摸底练习3.png


实战11作业(安冬).rar

54.5 KB, 下载次数: 3

数透是手动的

回复 支持 反对

使用道具 举报

发表于 2017-9-21 09:11:11 | 显示全部楼层
尝试做了一下,请老师批阅。

SQL 摸底(0基础同学请跳过)(绿叶霞光).zip

51.46 KB, 下载次数: 9

回复 支持 反对

使用道具 举报

发表于 2017-9-21 15:33:33 | 显示全部楼层
求作业3思路

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

43.47 KB, 下载次数: 2

QQ:449372956

回复 支持 反对

使用道具 举报

发表于 2017-9-23 08:50:27 | 显示全部楼层
练习1
  1. select 班级,学生编号, 语文, 数学,英语,iif(isnull(语文),0,语文)+iif(isnull(数学),0,数学)+iif(isnull(英语),0,英语) as 总分 from [成绩表$]
复制代码
练习2
  1. select * from [成绩表$] where 语文 is null or 数学 is null or 英语 is null
复制代码
练习3
  1. select 班级,科目,iif(分数>=90,"90-100分",iif(分数>=80,"80-90分",iif(分数>=70,"70-80分",iif(分数<=60,"60-70分",iif(isnull(分数),"缺考","不及格"))))) as 分数段 from(select 班级,"语文" as 科目,语文 as 分数 from [成绩表$] union all  select 班级,"数学" as 科目,数学 as 分数 from [成绩表$] union all  select 班级,"英语" as 科目,英语 as 分数 from [成绩表$])
复制代码
QQ拼音截图20170923084852.png
回复 支持 反对

使用道具 举报

发表于 2017-9-24 15:02:38 | 显示全部楼层
Sub SQL摸底练习1() '正式课11SQL摸底,计算总分

    Dim rst As New ADODB.Recordset
    Dim conn As New ADODB.Connection
    Dim sql As String
    conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=" _
    & "excel 12.0;data source=" & ThisWorkbook.FullName
    sql = "select A.*,iif(isnull(语文),0,语文) + iif(isnull(数学),0,数学)+ iif(isnull(英语),0,英语) as 总分 from [成绩表$] A"
    Worksheets("练习1").[a2].Resize(1, 6) = Array("班级", "学生编号", "语文", "数学", "英语", "总分")
    Worksheets("练习1").[a3].CopyFromRecordset conn.Execute(sql)
    conn.Close
    Set rst = Nothing
    Set conn = Nothing

End Sub


Sub SQL摸底练习2() '正式课11SQL摸底,筛选缺考

    Dim rst As New ADODB.Recordset
    Dim conn As New ADODB.Connection
    Dim sql As String
    conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=" _
    & "excel 12.0;data source=" & ThisWorkbook.FullName
    sql = "select A.* from [成绩表$] A where isnull(语文)=true or isnull(数学)=true or isnull(英语)=true"
    Worksheets("练习2").[a2].Resize(1, 5) = Array("班级", "学生编号", "语文", "数学", "英语")
    Worksheets("练习2").[a3].CopyFromRecordset conn.Execute(sql)
    conn.Close
    Set rst = Nothing
    Set conn = Nothing

End Sub

回复 支持 反对

使用道具 举报

发表于 2017-9-29 17:04:54 | 显示全部楼层
  1. Sub 作业11_练习1()
  2. '求总分
  3.     Dim conn As Object, sql$
  4.     Set conn = CreateObject("adodb.connection")
  5.     conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" _
  6.     & ThisWorkbook.FullName
  7.     sql = "select 班级,学生编号, 语文, 数学,英语,iif(isnull(语文),0,语文)+iif(isnull(数学),0,数学)+iif(isnull(英语),0,英语) as 总分 from [成绩表$]"
  8.     Sheets("练习1").Range("g4").CopyFromRecordset conn.Execute(sql)
  9. End Sub

  10. Sub 作业11_练习2()
  11. '找出科目有缺考的学生记录
  12.     Dim conn As Object, sql$
  13.     Set conn = CreateObject("adodb.connection")
  14.     conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" _
  15.     & ThisWorkbook.FullName
  16.     sql = "select * from [成绩表$] where 语文 is null or 数学 is null or 英语 is null"
  17.     Sheets("练习2").Range("f3").CopyFromRecordset conn.Execute(sql)
  18.     Range("f2").Resize(1, 5) = Array("班级", "学生编号", "语文", "数学", "英语")
  19.     Range("f2").CurrentRegion.Borders.LineStyle = xlContinuous
  20. End Sub

  21. 作业3还没做出来......
复制代码

回复 支持 反对

使用道具 举报

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

本版积分规则

关闭

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

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