设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 请教大神：VBA运行错误1004怎样解决？
数据透视表40+个常用小技巧，让你一次学会！
返回列表 发新帖
查看: 3015|回复: 8

[已解决]请教大神：VBA运行错误1004怎样解决？

[复制链接]
发表于 2016-1-4 20:15 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 白云无尽9987 于 2016-1-4 20:29 编辑
  1. Sub 班级成绩统计() '27行
  2.   Sheets("kk").Range("g7:i21").ClearContents
  3.     With ActiveSheet
  4.         arr = .[a1].CurrentRegion
  5.         rs = 7 '第7行
  6.         mf = Array(100, 100, 100)       '各科满分值
  7.         For j = 7 To 9 '第7----9列
  8.             Set Rng = .Cells(46, j).Resize(UBound(arr) - 1)
  9.              .Cells(rs + 0, j) = Application.WorksheetFunction.CountA(Sheets("KK").Range("E46:E115")) '应到人数
  10.              .Cells(rs + 1, j) = Application.WorksheetFunction.Count(Rng)     '各科目参考人数
  11.              .Cells(rs + 2, j) = .Cells(rs + 0, j) - .Cells(rs + 1, j) '各科目缺考人数
  12.              .Cells(rs + 3, j) = Application.WorksheetFunction.Sum(Rng)   '各科目总分
  13.             
  14.             
  15.             .Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)   '各科目均分_______________________________________________________________________________________________________________________________________________________?


  18.              ' yx = mf(j - 4) * 0.8: jg = mf(j - 4) * 0.6
  19.             YX = 80: JG = 60: DF = 30
  20.             .Cells(rs + 5, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & YX)  '各科目优秀人数
  21.             .Cells(rs + 6, j) = Round(.Cells(rs + 5, j) / .Cells(rs + 1, j), 2) '各科目优秀率
  22.             .Cells(rs + 11, j) = Application.WorksheetFunction.CountIf(Rng, "<" & DF)  '各科目低分人数
  23.             .Cells(rs + 12, j) = Round(.Cells(rs + 11, j) / .Cells(rs + 1, j), 2) '各科目低分率
  24.             .Cells(rs + 13, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & JG)  '各科目及格人数
  25.             .Cells(rs + 14, j) = Round(.Cells(rs + 13, j) / .Cells(rs + 1, j), 2) '各科目及格率
  26.             
  27.              .Cells(rs + 7, j) = .Cells(rs + 13, j) - .Cells(rs + 5, j)     '各科目良好人数_____________及格-优秀OK
  28.              .Cells(rs + 8, j) = Round(.Cells(rs + 7, j) / .Cells(rs + 1, j), 2) '各科目良好率
  29.              .Cells(rs + 9, j) = .Cells(rs + 1, j) - .Cells(rs + 13, j) - .Cells(rs + 11, j)       '各科目中等人数_____________参考-及格-低分OK
  30.              .Cells(rs + 10, j) = Round(.Cells(rs + 7, j) / .Cells(rs + 1, j), 2) '各科目中等率
  31.         Next
  32.     End With
  33. End Sub
复制代码
9999.rar (157.54 KB, 下载次数: 9)
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
发表于 2016-1-4 21:03 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
加个判断，只有在实到人数不为0(或者总分不为0，等条件）时才进行分数段统计
回复

使用道具 举报

 楼主| 发表于 2016-1-4 21:36 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
本帖最后由 白云无尽9987 于 2016-1-4 21:40 编辑
青城山苦丁茶 发表于 2016-1-4 21:03
加个判断，只有在实到人数不为0(或者总分不为0，等条件）时才进行分数段统计

怎样加？小白多谢大神！！
多次尝试IF / IFERROR没有成功？
如果着眼于下面的语句能够修改成功，应该就是最捷径的吧！？
.Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)

回复

使用道具 举报

发表于 2016-1-4 22:10 | 显示全部楼层
单纯那一句可以写成：
If .Cells(rs + 3, j) Then .Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)
可是后面会继续出错
所以直接写成
If .Cells(rs + 3, j) Then
   .Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)
   继续加,到除法都算完
end if
回复

使用道具 举报

 楼主| 发表于 2016-1-4 22:18 | 显示全部楼层
青城山苦丁茶 发表于 2016-1-4 22:10
单纯那一句可以写成：
If .Cells(rs + 3, j) Then .Cells(rs + 4, j) = Round(Application.WorksheetFunct ...

能否上个经过测试成功的附件，我做过，再次去做还是一样！多谢了！！
回复

使用道具 举报

grf1973
发表于 2016-1-5 10:11 | 显示全部楼层    本楼为最佳答案   
  1. Sub 班级成绩统计() '27行
  2.   Sheets("kk").Range("g7:i21").ClearContents
  3.     With ActiveSheet
  4.         arr = .[a1].CurrentRegion
  5.         rs = 7 '第7行
  6.         mf = Array(100, 100, 100)       '各科满分值
  7.         For j = 7 To 9 '第7----9列
  8.             Set Rng = .Cells(46, j).Resize(UBound(arr) - 1)
  9.              .Cells(rs + 0, j) = Application.WorksheetFunction.CountA(Sheets("KK").Range("E46:E115")) '应到人数
  10.              zrs = Application.WorksheetFunction.Count(Rng)     '各科目参考人数
  11.              .Cells(rs + 1, j) = zrs   '总人数
  12.              .Cells(rs + 2, j) = .Cells(rs + 0, j) - .Cells(rs + 1, j) '各科目缺考人数
  13.              .Cells(rs + 3, j) = Application.WorksheetFunction.Sum(Rng)   '各科目总分
  14.             If Application.WorksheetFunction.Sum(Rng) > 0 Then
  15.                 .Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)   '各科目均分
  16.             End If


  19.              ' yx = mf(j - 4) * 0.8: jg = mf(j - 4) * 0.6
  20.             YX = 80: JG = 60: DF = 30
  21.             .Cells(rs + 5, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & YX)  '各科目优秀人数
  22.             .Cells(rs + 11, j) = Application.WorksheetFunction.CountIf(Rng, "<" & DF)  '各科目低分人数
  23.             .Cells(rs + 13, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & JG)  '各科目及格人数
  24.              .Cells(rs + 7, j) = .Cells(rs + 13, j) - .Cells(rs + 5, j)     '各科目良好人数_____________及格-优秀OK
  25.              .Cells(rs + 9, j) = .Cells(rs + 1, j) - .Cells(rs + 13, j) - .Cells(rs + 11, j)       '各科目中等人数_____________参考-及格-低分OK
  26.             
  27.              If zrs > 0 Then
  28.                 .Cells(rs + 6, j) = Round(.Cells(rs + 5, j) / zrs, 2) '各科目优秀率
  29.                 .Cells(rs + 12, j) = Round(.Cells(rs + 11, j) / zrs, 2) '各科目低分率
  30.                 .Cells(rs + 14, j) = Round(.Cells(rs + 13, j) / zrs, 2) '各科目及格率
  31.                 .Cells(rs + 8, j) = Round(.Cells(rs + 7, j) / zrs, 2) '各科目良好率
  32.                 .Cells(rs + 10, j) = Round(.Cells(rs + 7, j) / zrs, 2) '各科目中等率
  33.             End If
  34.         Next
  35.     End With
  36. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
白云无尽9987 + 3 我和小伙伴都惊呆了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-1-5 10:48 | 显示全部楼层
grf1973 发表于 2016-1-5 10:11

多谢grf大神帮教，感觉思路好清晰啊！抑制不住内心汹涌的感激和喜悦之情，现在最想做的事就是马上去测试一下，无奈停电了，晕！
回复

使用道具 举报

grf1973
发表于 2016-1-5 11:38 | 显示全部楼层
继续优化一下。
  1. Sub 班级成绩统计() '27行
  2.     With Sheets("kk")
  3.         .Range("g7:i21").ClearContents
  4.         r = .[d65536].End(3).Row
  5.         rs = 7 '第7行
  6.         ydrs = Application.WorksheetFunction.CountA(.Range(.Cells(46, 5), .Cells(r, 5)))       '应到人数
  7.         YX = 80: JG = 60: DF = 30        '优秀、及格、低分分数线
  8.         For j = 7 To 9 '第7----9列
  9.             Set Rng = .Range(.Cells(46, j), .Cells(r, j))
  10.              .Cells(rs, j) = ydrs  '应到人数
  11.              sdrs = Application.WorksheetFunction.Count(Rng)     '各科目参考人数（实到人数）
  12.              .Cells(rs + 1, j) = sdrs   '实到人数
  13.              .Cells(rs + 2, j) = ydrs - sdrs '各科目缺考人数
  14.              .Cells(rs + 3, j) = Application.WorksheetFunction.Sum(Rng)   '各科目总分
  15.             If .Cells(rs + 3, j) > 0 Then .Cells(rs + 4, j) = Round(Application.WorksheetFunction.Average(Rng), 2)   '各科目均分

  17.             .Cells(rs + 5, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & YX)  '各科目优秀人数
  18.             .Cells(rs + 11, j) = Application.WorksheetFunction.CountIf(Rng, "<" & DF)  '各科目低分人数
  19.             .Cells(rs + 13, j) = Application.WorksheetFunction.CountIf(Rng, ">=" & JG)  '各科目及格人数
  20.              .Cells(rs + 7, j) = .Cells(rs + 13, j) - .Cells(rs + 5, j)     '各科目良好人数_____________及格-优秀OK
  21.              .Cells(rs + 9, j) = .Cells(rs + 1, j) - .Cells(rs + 13, j) - .Cells(rs + 11, j)       '各科目中等人数_____________参考-及格-低分OK
  22.             
  23.              If sdrs > 0 Then
  24.                 For k = 6 To 14 Step 2
  25.                     .Cells(rs + k, j) = Round(.Cells(rs + k - 1, j) / sdrs, 2) '各科目优秀、及格、低分、良好、中等率
  26.                 Next
  27.             End If
  28.         Next
  29.     End With
  30. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
白云无尽9987 + 3 赞一个

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2016-1-5 12:41 | 显示全部楼层
6楼第6行和第19行所具备的灵活性只用8楼第7行来代替，怕是得不偿失！
五体投地，跪谢大神！！！
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-4-26 10:38 , Processed in 0.544824 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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