Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2844|回复: 7

[通知] Excel 2015VBA初级2班第5课A组作业上交贴(已开贴)

[复制链接]
发表于 2015-11-14 19:04 | 显示全部楼层 |阅读模式
本帖最后由 雪舞子 于 2015-11-18 17:30 编辑

作业说明及要求:

1、根据第五课所讲的内容,按老师布置的作业,编写一段自认为精练的代码;
2、提交作业请注明论坛ID及学号。如:A01-麻花_;
3、作业请以代码方式提交,标清题号并所有题贴到一个代码标签中,无需提交附件。 不会使用标签可移步帖子:http://www.excelpx.com/thread-322284-1-1.html
4、代码题要求强制声明变量,关键语句标明注释,代码缩进;不会缩进可使用缩进小工具:http://www.excelpx.com/thread-366281-1-1.html
5、跟帖不要重复占楼,有问题直接在原帖编辑;
6、本次课程安排紧凑,时间紧任务重,同学们加油!
7、作业截止时间:第6课上课日之18:00时

评分

参与人数 1 +15 收起 理由
air05 + 15 赞一个!师傅辛苦了

查看全部评分

发表于 2015-11-14 20:35 | 显示全部楼层
A02-guofei0344
  1. Sub 字母统计字典()
  2. Dim d As New Dictionary, arr, i, j, sum
  3.     arr = Split(Range("D2"), "+")
  4.     For j = 3 To Range("a3").End(xlDown).Row
  5.         For i = 0 To UBound(arr)
  6.             If Cells(j, 1) = arr(i) Then
  7.                 d.Item(arr(i)) = Cells(j, 2)
  8.                 sum = sum + d.Item(arr(i))
  9.             End If
  10.         Next
  11.     Next
  12.     Range("E3") = sum
  13. End Sub
复制代码
  1. Sub 字母统计数组()
  2. Dim arr, arr1, i As Byte, j As Byte, sum As Long
  3.     arr = Split(Range("D2"), "+")
  4.     arr1 = Range("a3:B30")
  5.     For i = 1 To UBound(arr1)
  6.         For j = 0 To UBound(arr)
  7.             If arr1(i, 1) = arr(j) Then
  8.                 sum = sum + arr1(i, 2)
  9.             End If
  10.         Next
  11.     Next
  12.     Range("e2") = sum
  13. End Sub
复制代码

点评

用了两种方法,不错。不过利用字典时不推荐直接使用单元格,否则会出现意想不到的结果。  发表于 2015-11-17 17:37

评分

参与人数 1 +19 金币 +19 收起 理由
雪舞子 + 19 + 19 很给力!

查看全部评分

回复

使用道具 举报

发表于 2015-11-15 14:23 | 显示全部楼层
本帖最后由 ZL在水一方 于 2015-11-15 22:22 编辑

A12-ZL在水一方
  1. Option Explicit
  2. Sub 求和1_数组法()
  3. '******将单元格数据放入数组******
  4. Dim arr As Variant, brr As Variant
  5. arr = [a2].CurrentRegion
  6. brr = Split([d2], "+")

  7. '******数组间执行语句******
  8. Dim i As Integer, j As Integer, Sums As Integer
  9. For i = 1 To UBound(arr)
  10.     For j = LBound(brr) To UBound(brr)
  11.         If arr(i, 1) = brr(j) Then
  12.             Sums = Sums + arr(i, 2)
  13.         End If
  14.     Next j
  15. Next i

  16. '******将结果放入单元格******
  17. [e2] = Sums

  18. End Sub
复制代码
  1. Option Explicit
  2. Sub 求和2_字典()
  3. '******引用Microsoft Scripting Runtime,创建字典******
  4. Dim Dic As Dictionary
  5. Set Dic = New Dictionary
  6. [d4:e100].ClearContents

  7. '******往字典中存数据******
  8. Dim arr As Variant, brr As Variant, i As Integer, j As Variant, Sums As Integer
  9. arr = [a2].CurrentRegion
  10. brr = Split([d2], "+")
  11. For i = LBound(arr) To UBound(arr)
  12.     Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
  13. Next i

  14. For j = LBound(brr) To UBound(brr)
  15.     If Dic.Exists(brr(j)) Then
  16.         Sums = Sums + Dic(brr(j))
  17.     End If
  18. Next j
  19.    
  20. '******将结果输出至单元格******
  21. [e2] = Sums

  22. End Sub
复制代码

点评

两种方法都很好,结果正确。继续努力!  发表于 2015-11-17 17:38

评分

参与人数 1 +20 金币 +20 收起 理由
雪舞子 + 20 + 20 缩进有些小问题,加油!

查看全部评分

回复

使用道具 举报

发表于 2015-11-15 17:36 | 显示全部楼层
  1. Sub 数字求和()
  2. Dim i As String, arr() As String
  3.     i = Application.InputBox("请输入你要求和的大写字母,以”+“相隔", , , , , , 2)
  4.     If Len(i) Then '如果i的字符大于0 跳转到1 如果输入为空 或者取消跳出程序
  5.         GoTo 1
  6.     Else
  7.         Exit Sub
  8.     End If
  9. 1:    arr = Split(i, "+") '以+号分列成一维数组赋值到arr
  10. Dim brr, sums As Double, j As Integer, k As Integer '定义 变量brr sums j k
  11. brr = Range("a3:b" & Range("a3").End(xlDown).Row)   '将a3到b列最后一个区域放进数组 brr
  12. For j = 1 - 1 To UBound(arr)    'j=1到arr 数组上限
  13.     For k = 1 To UBound(brr)    'k=1 到brr 数组上限
  14.         If brr(k, 1) = arr(j) Then '循环brr 是否等于 arr
  15.             sums = brr(k, 2) + sums     '等于就将brr加和到sums
  16.         End If
  17.     Next k
  18. Next j
  19. Range("e2") = sums      '将sums结果放进e2单元格
  20. End Sub
复制代码

点评

使用输入交互,注释清楚,字典运用的很不错。加油!  发表于 2015-11-17 17:45

评分

参与人数 1 +20 金币 +20 收起 理由
雪舞子 + 20 + 20 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2015-11-15 18:28 | 显示全部楼层
本帖最后由 建峰 于 2015-11-15 18:29 编辑

A06:建峰
  1. Option Explicit '强制声明变量

  2. Sub 字母统计()                                                   '创建过程名称"字母统计"
  3.     '第一步,把数据装入数组
  4.     Dim arr                                                     '定义数组
  5.     arr = Range("a3:b" & Cells(Rows.Count, 1).End(xlUp).Row)    '将数据装入数组
  6.    
  7.     '第二步,进行计算
  8.     Dim i As Long, mysum As Long, j As String, k As String
  9.     '定义计数器i,定义变量mysum,定义变量j,定义变量k
  10.     k = "+" & Range("d2") & "+"                                 'D2单元格的值前后加+号后装入变量k
  11.     For i = 1 To UBound(arr)                                    '当i为从1到数组i的最大行数时
  12.         j = "+" & arr(i, 1) & "+"                               '将arr(i,1)的值前后加+后装入变量j
  13.         If InStr(1, k, j) > 0 Then mysum = mysum + arr(i, 2)
  14.         '如果j在k里面存在,那么将arr(i,2)的值加到mysum中
  15.     Next                                                        '下一个i
  16.    
  17.     '第三步,把结果输出到单元格
  18.     Range("e2") = mysum                                         '将结果输出到答题区E2单元格
  19. End Sub                                                         '结束过程
复制代码
回答完毕!

点评

使用数组方法结果完全正确,注释清楚明确。本题主要练习字典的使用方法略显不足。  发表于 2015-11-17 17:52

评分

参与人数 1 +19 金币 +19 收起 理由
雪舞子 + 19 + 19 赞一个!

查看全部评分

回复

使用道具 举报

发表于 2015-11-17 17:43 | 显示全部楼层
  1. 不会。。我再想想。
复制代码

点评

加油!  发表于 2015-11-18 17:18

评分

参与人数 1 +5 金币 +5 收起 理由
雪舞子 + 5 + 5 淡定

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2015-11-18 17:27 | 显示全部楼层
本次作业不难,同学们用字典或数组都做的都不错。我用窗体做一下,可以任意选择字母(项目),
代码没什么技术含量,主要是利用了字典对重复项进行统计,并动态加载checkbox控件,由于checkbox控件数量不固定,
加载时需要根据控件数量计算加载的位置:

zy.jpg

第5讲作业.rar (25.19 KB, 下载次数: 6)

评分

参与人数 1 +9 收起 理由
神隐汀渚 + 9 不明觉厉

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2015-11-18 17:29 | 显示全部楼层
作业截止------------------------------------------------------------------------------------
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 03:50 , Processed in 0.525889 second(s), 21 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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