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

零基础学ExcelVBA 第十一期 第八课时作业贴

[复制链接]
发表于 2017-7-26 20:26:55 | 显示全部楼层 |阅读模式
本帖最后由 开心妙妙 于 2017-8-12 11:21 编辑

交作业的要求:

1、不需要附件,只需贴代码,说明你做的是哪道题
2、贴上的代码都需要缩进,并且关键语句要有注释
3、请在添加代码文字,那里添加代码,这样代码在楼层中显得赏心悦目。不知道怎样操作的小伙伴,可以参照看动画。

113058c5vzhlg55gq16qpg.gif
回复

使用道具 举报

发表于 2017-7-27 11:19:51 | 显示全部楼层

RE: 零基础学ExcelVBA 第十一期 第八课时作业贴

本帖最后由 cynthiashi 于 2017-8-2 11:22 编辑

Sub 水浒英雄考试处理()

    Dim i As Long, j As Long, fail As Long, pass As Long, outstanding As Long
    For i = 2 To Range("a1").CurrentRegion.Rows.count
        fail = 0
        pass = 0
        outstanding = 0
        For j = Range("d1").Column To Range("i1").Column
            If Cells(i, j) < 60 Then
                fail = fail + 1
            ElseIf Cells(i, j) >= 85 Then
                outstanding = outstanding + 1
            Else
                pass = pass + 1
            End If
            If fail >= 3 Then
                Range("k" & i) = "勒令退学"
            ElseIf fail = 2 Then
                Range("k" & i) = "留级"
            ElseIf fail = 1 Then
                Range("k" & i) = "补考"
            ElseIf outstanding = 6 Then
                Range("k" & i) = "奖学金"
            Else
                Range("k" & i) = "合格"
            End If
        Next
    Next
   
End Sub


Sub 不及格学生名单和成绩()
    Dim i As Long, j As Long '定义循环变量
    Dim xrow As Long, k As Long, l As Long, m As Long '定义待填写区域的动态行数及列数
    k = 8
    l = 9
    m = 10
    For i = Range("d2").Column To Range("h2").Column
        k = k + 3
        l = l + 3
        m = m + 3
        xrow = 2
        For j = 3 To Range("a1").CurrentRegion.Rows.Count
            If Cells(j, i) < 60 Then
                xrow = xrow + 1
                Cells(xrow, k) = Cells(j, 1)
                Cells(xrow, l) = Cells(j, 3)
                Cells(xrow, m) = Cells(j, i)
            End If
        Next
    Next
   
End Sub




Sub 吃太饱()
     Dim i As Long, remainprofit As Double, profit As Double, bonus As Double
     For i = 2 To Range("a1").CurrentRegion.Rows.Count
         bonus = 0
         remainprofit = Cells(i, 2).Value
         Do Until remainprofit <= 0
             Select Case remainprofit
             Case Is > 100
                 profit = remainprofit - 100
                 bonus = bonus + profit * 0.8
                 remainprofit = remainprofit - profit
             Case Is > 60
                 profit = remainprofit - 60
                 bonus = bonus + profit * 0.5
                 remainprofit = remainprofit - profit
             Case Is > 40
                 profit = remainprofit - 40
                 bonus = bonus + profit * 0.3
                 remainprofit = remainprofit - profit
             Case Is > 20
                 profit = remainprofit - 20
                 bonus = bonus + profit * 0.2
                 remainprofit = remainprofit - profit
             Case Is > 10
                 profit = remainprofit - 10
                 bonus = bonus + profit * 0.1
                 remainprofit = remainprofit - profit
             Case Else
                 profit = remainprofit
                 bonus = bonus + profit * 0.05
                 remainprofit = remainprofit - profit
             End Select
         Loop
         Cells(i, 3) = bonus * 10000
     Next
     
End Sub






点评

赞,思路代码结构很棒  发表于 2017-8-10 15:51
回复 支持 反对

使用道具 举报

发表于 2017-7-27 15:24:06 | 显示全部楼层
  1. Sub 水浒1()
  2. Dim h As Long, l As Long, ma As Long, he As Long
  3. For h = 2 To Sheet11.UsedRange.Rows.Count
  4. ma = 0
  5. he = 0
  6.     For l = 4 To 9
  7.         Select Case Cells(h, l)
  8.         Case Is >= 85
  9.         ma = ma + 1
  10.         Case Is < 60
  11.         he = he + 1
  12.         End Select
  13.      Next
  14.         Select Case he
  15.         Case Is = 0
  16.         Range("k" & h) = "通过"
  17.         Case Is = 1
  18.         Range("k" & h) = "补考"
  19.         Case Is = 2
  20.         Range("k" & h) = "留级"
  21.         Case Is >= 3
  22.         Range("k" & h) = "勒令退学"
  23.         End Select
  24.         If ma = 6 Then Range("k" & h) = "奖学金"
  25.      Next
  26. End Sub


  27. Sub 不及格2()
  28. Dim h As Long, l As Long, i As Integer
  29. For l = 1 To 5
  30. i = 3
  31. For h = 3 To Range("a" & Rows.Count).End(xlUp).Row
  32.     Select Case Cells(h, l + 3)
  33.     Case Is < 60
  34.     Cells(i, 8 + l * 3) = Cells(h, 1)
  35.     Cells(i, 9 + l * 3) = Cells(h, 3)
  36.     Cells(i, 10 + l * 3) = Cells(h, l + 3)
  37.     i = i + 1
  38.     End Select
  39.     Next
  40.     Next
  41.    
  42. End Sub


  43. Sub 吃太饱3()
  44. Dim h As Long, l As Double, a  As Double
  45. For h = 2 To Range("a" & Rows.Count).End(xlUp).Row
  46. a = Cells(h, 2)
  47. l = Cells(h, 3)
  48.     Select Case a
  49.     Case Is > 100               '超100
  50.     l = (a - 100) * 0.8 + 40 * 0.5 + 20 * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05
  51.     Case Is >= 60              '100--60
  52.     l = (a - 60) * 0.5 + 20 * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05
  53.     Case Is >= 40             '40-60
  54.     l = (a - 40) * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05
  55.     Case Is >= 20             '20-40
  56.     l = (a - 20) * 0.2 + 10 * 0.1 + 10 * 0.05
  57.     Case Is >= 10         '10-20
  58.     l = (a - 10) * 0.1 + 10 * 0.05
  59.     Case Else
  60.     l = a * 0.05
  61.     End Select
  62.     Cells(h, 3) = l * 10000
  63. Next
  64. End Sub
复制代码

点评

吃太饱3:如果正确,方法不太理想 如果增加档位 需要大面积修改代码,可参看2楼的代码思路  发表于 2017-8-10 16:17
全部结果正确,赞  发表于 2017-8-10 16:15
回复 支持 反对

使用道具 举报

发表于 2017-7-27 20:32:50 | 显示全部楼层
本帖最后由 师小五 于 2017-7-31 22:45 编辑
  1. Option Explicit

  2. Sub 水浒英雄读书()
  3.     Dim i%, j&, num&, num2&
  4.     For i = 2 To Cells(1, 1).CurrentRegion.Rows.Count
  5.         num = 0: num2 = 0
  6.         
  7.         For j = 4 To 9
  8.             
  9.             If Cells(i, j).Value < 60 Then
  10.                 num = num + 1
  11.             ElseIf Cells(i, j).Value >= 85 Then
  12.                 num2 = num2 + 1
  13.             End If
  14.             
  15.         Next

  16.         Select Case num
  17.             Case Is >= 3
  18.                 Cells(i, 11) = "勒令退学"
  19.             Case Is = 2
  20.                 Cells(i, 11) = "留级"
  21.             Case Is = 1
  22.                 Cells(i, 11) = "补考"
  23.             Case Is = 0
  24.                 Cells(i, 11) = "全部合格"
  25.         End Select
  26.         
  27.         If num2 = 6 Then Cells(i, 11) = "奖学金"
  28.    
  29.     Next
  30. End Sub


  31. Sub 测验不及极成绩() '纵向循环
  32.     Dim i&, j&, m&
  33.    
  34.     For j = 4 To 8
  35.         m = 2
  36.         For i = 3 To Range("a1").CurrentRegion.Rows.Count
  37.                
  38.             If Cells(i, j) < 60 Then
  39.                 m = m + 1
  40.                 Cells(m, 3 * j + 1) = Cells(i, j).Value
  41.                 Cells(m, 3 * j) = Cells(i, 3)
  42.                 Cells(m, 3 * j - 1) = Cells(i, 1)
  43.              End If

  44.         Next
  45.     Next
  46. End Sub
  47. Sub 不及格成绩统计() '横向循环
  48.     Dim i&, j&, m&
  49.     For i = 3 To Range("a1").CurrentRegion.Rows.Count
  50.         For j = 4 To 8
  51.             If Cells(i, j) < 60 Then
  52.                 m = Cells(i, 3 * j + 1).End(xlUp).Row + 1
  53.                 Cells(m, 3 * j + 1) = Cells(i, j).Value
  54.                 Cells(m, 3 * j) = Cells(i, 3)
  55.                 Cells(m, 3 * j - 1) = Cells(i, 1)
  56.             End If
  57.         Next
  58.     Next
  59. End Sub

  60. <blockquote>
复制代码

点评

正确:思路代码赞!  发表于 2017-8-10 16:19
回复 支持 反对

使用道具 举报

发表于 2017-7-28 00:33:51 | 显示全部楼层
本帖最后由 沐妞是个妞 于 2017-7-31 23:57 编辑
  1. <p>
  2. Sub 成绩表()

  3. Dim i As Long, j As Long, n As Long, m As Long
  4.     For i = 2 To Range("A1").CurrentRegion.Rows.Count
  5.         n = 0
  6.         m = 0
  7.         For j = 4 To 9
  8.             If Cells(i, j) < 60 Then
  9.                 n = n + 1
  10.             ElseIf Cells(i, j) >= 85 Then
  11.                 m = m + 1
  12.             End If
  13.         Next
  14.             If m = 6 Then
  15.                 Cells(i, 11) = "奖学金"
  16.             ElseIf n >= 3 Then
  17.                 Cells(i, 11) = "勒令退学"
  18.             ElseIf n = 2 Then
  19.                 Cells(i, 11) = "留级"
  20.             ElseIf n = 1 Then
  21.                 Cells(i, 11) = "补考"
  22.             Else
  23.                 Cells(i, 11) = "通过"
  24.             End If
  25.         Next
  26.         
  27. End Sub

  28. Sub 全级()

  29. Dim i As Long, j As Long, m As Long, n As Long
  30.     m = 11
  31.    For j = 4 To 8
  32.         n = 3
  33.         For i = 3 To Range("a3").CurrentRegion.Rows.Count
  34.             If Cells(i, j) < 60 Then
  35.                 Cells(n, m) = Cells(i, 1)
  36.                 Cells(n, m + 1) = Cells(i, 3)
  37.                 Cells(n, m + 2) = Cells(i, j)
  38.                 n = n + 1
  39.             End If
  40.         Next
  41.         m = m + 3
  42.     Next
  43. End Sub

  44. Sub 吃太饱循环版()
  45. Dim amt As Double, amt2 As Double, inctv As Double, inctvttl As Double, i As Long
  46.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
  47.         amt = Range("b" & i)
  48.         inctvttl = 0
  49.         Do
  50.          
  51.             Select Case amt
  52.                 Case Is > 100
  53.                 inctv = (amt - 100) * 0.8
  54.                 amt = 100
  55.                 Case Is > 60
  56.                 inctv = (amt - 60) * 0.5
  57.                 amt = 60
  58.                 Case Is > 40
  59.                 inctv = (amt - 40) * 0.3
  60.                 amt = 40
  61.                 Case Is > 20
  62.                 inctv = (amt - 20) * 0.2
  63.                 amt = 20
  64.                 Case Is > 10
  65.                 inctv = (amt - 10) * 0.1
  66.                 amt = 10
  67.                 Case Else
  68.                 inctv = amt * 0.05
  69.                 amt = 0
  70.             End Select
  71.            inctvttl = inctvttl + inctv
  72.         Loop Until amt = 0
  73.         Range("c" & i) = inctvttl * 10000
  74.    Next</p><p>End Sub

  75. </p>
复制代码

点评

全部正确:思路代码很棒,赞  发表于 2017-8-10 16:24
回复 支持 反对

使用道具 举报

发表于 2017-7-28 00:45:25 | 显示全部楼层
  1. '作业1
  2. Sub 水浒英雄考试处理()
  3.     Dim i As Long, j As Long
  4.     Dim 不及格 As Long, 优秀 As Long
  5.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
  6.         For j = 4 To 9
  7.         If Cells(i, j).Value < 60 Then
  8.             不及格 = 不及格 + 1
  9.         ElseIf Cells(i, j).Value >= 85 Then
  10.             优秀 = 优秀 + 1
  11.         End If
  12.     Next
  13.         If 不及格 >= 3 Then
  14.             Cells(i, 11) = "勒令退学"
  15.         ElseIf 不及格 = 2 Then
  16.             Cells(i, 11) = "留级"
  17.         ElseIf 不及格 = 1 Then
  18.             Cells(i, 11) = "补考"
  19.         ElseIf 优秀 = 6 Then
  20.             Cells(i, 11) = "奖学金"
  21.         Else
  22.             Cells(i, 11) = "通过"
  23.         End If
  24.         不及格 = 0
  25.         优秀 = 0
  26.     Next
  27. End Sub
复制代码
  1. '作业2
  2. Sub 求不及格学生名单和成绩()
  3.     Dim i As Long, j As Long, m As Long
  4.     Dim 班级 As Long, 姓名 As Long, 成绩 As Long
  5.     班级 = 11
  6.     姓名 = 班级 + 1
  7.     成绩 = 班级 + 2
  8.     For m = 4 To Range("a1").CurrentRegion.Columns.Count
  9.         j = 2
  10.         For i = 3 To Range("a1").CurrentRegion.Rows.Count
  11.             If Cells(i, m).Value < 60 Then
  12.                 j = j + 1
  13.                 Cells(j, 班级) = Cells(i, 1)
  14.                 Cells(j, 姓名) = Cells(i, 3)
  15.                 Cells(j, 成绩) = Cells(i, m)
  16.             End If
  17.         Next
  18.         班级 = 班级 + 3
  19.         姓名 = 姓名 + 3
  20.         成绩 = 成绩 + 3
  21.     Next
  22. End Sub
复制代码
  1. '作业3 吃太饱
  2. Sub 吃太饱()
  3.     Dim i As Long, 奖金额 As Double, 奖金额2 As Double, 奖金额3 As Double
  4.     Dim 奖金额4 As Double, 奖金额5 As Double, 利润 As Double
  5.     奖金额 = 10 * 0.05
  6.     奖金额2 = 奖金额 + 10 * 0.1
  7.     奖金额3 = 奖金额2 + 20 * 0.2
  8.     奖金额4 = 奖金额3 + 20 * 0.3
  9.     奖金额5 = 奖金额4 + 40 * 0.5
  10.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
  11.         If Range("b" & i) < 10 Then
  12.             Range("c" & i) = (Range("b" & i).Value * 0.05) * 10000
  13.         ElseIf Range("b" & i) <= 20 Then
  14.             Range("c" & i) = (奖金额 + (Range("b" & i).Value - 10) * 0.1) * 10000
  15.         ElseIf Range("b" & i) <= 40 Then
  16.             Range("c" & i) = (奖金额2 + (Range("b" & i).Value - 20) * 0.2) * 10000
  17.         ElseIf Range("b" & i) <= 60 Then
  18.             Range("c" & i) = (奖金额3 + (Range("b" & i).Value - 40) * 0.3) * 10000
  19.         ElseIf Range("b" & i) <= 100 Then
  20.             Range("c" & i) = (奖金额4 + (Range("b" & i).Value - 60) * 0.5) * 10000
  21.         Else
  22.             Range("c" & i) = (奖金额5 + (Range("b" & i).Value - 100) * 0.8) * 10000
  23.         End If
  24.     Next
  25. End Sub
复制代码


点评

吃太饱:结果正确, 方法不太理想 如果增加档位 需要大面积修改代码,可参看5楼代码思路  发表于 2017-8-10 17:16
全部正确,不错  发表于 2017-8-10 17:12
回复 支持 反对

使用道具 举报

发表于 2017-7-28 00:47:40 | 显示全部楼层
  1. '作业1
  2. Sub 水浒英雄考试处理()
  3.     Dim i As Long, j As Long
  4.     Dim 不及格 As Long, 优秀 As Long
  5.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
  6.         For j = 4 To 9
  7.         If Cells(i, j).Value < 60 Then
  8.             不及格 = 不及格 + 1
  9.         ElseIf Cells(i, j).Value >= 85 Then
  10.             优秀 = 优秀 + 1
  11.         End If
  12.     Next
  13.         If 不及格 >= 3 Then
  14.             Cells(i, 11) = "勒令退学"
  15.         ElseIf 不及格 = 2 Then
  16.             Cells(i, 11) = "留级"
  17.         ElseIf 不及格 = 1 Then
  18.             Cells(i, 11) = "补考"
  19.         ElseIf 优秀 = 6 Then
  20.             Cells(i, 11) = "奖学金"
  21.         Else
  22.             Cells(i, 11) = "通过"
  23.         End If
  24.         不及格 = 0
  25.         优秀 = 0
  26.     Next
  27. End Sub
复制代码
  1. '作业2
  2. Sub 求不及格学生名单和成绩()
  3.     Dim i As Long, j As Long, m As Long
  4.     Dim 班级 As Long, 姓名 As Long, 成绩 As Long
  5.     班级 = 11
  6.     姓名 = 班级 + 1
  7.     成绩 = 班级 + 2
  8.     For m = 4 To Range("a1").CurrentRegion.Columns.Count
  9.         j = 2
  10.         For i = 3 To Range("a1").CurrentRegion.Rows.Count
  11.             If Cells(i, m).Value < 60 Then
  12.                 j = j + 1
  13.                 Cells(j, 班级) = Cells(i, 1)
  14.                 Cells(j, 姓名) = Cells(i, 3)
  15.                 Cells(j, 成绩) = Cells(i, m)
  16.             End If
  17.         Next
  18.         班级 = 班级 + 3
  19.         姓名 = 姓名 + 3
  20.         成绩 = 成绩 + 3
  21.     Next
  22. End Sub
复制代码
  1. '作业3 吃太饱
  2. Sub 吃太饱()
  3.     Dim i As Long, 奖金额 As Double, 奖金额2 As Double, 奖金额3 As Double
  4.     Dim 奖金额4 As Double, 奖金额5 As Double, 利润 As Double
  5.     奖金额 = 10 * 0.05
  6.     奖金额2 = 奖金额 + 10 * 0.1
  7.     奖金额3 = 奖金额2 + 20 * 0.2
  8.     奖金额4 = 奖金额3 + 20 * 0.3
  9.     奖金额5 = 奖金额4 + 40 * 0.5
  10.     For i = 2 To Range("a1").CurrentRegion.Rows.Count
  11.         If Range("b" & i) < 10 Then
  12.             Range("c" & i) = (Range("b" & i).Value * 0.05) * 10000
  13.         ElseIf Range("b" & i) <= 20 Then
  14.             Range("c" & i) = (奖金额 + (Range("b" & i).Value - 10) * 0.1) * 10000
  15.         ElseIf Range("b" & i) <= 40 Then
  16.             Range("c" & i) = (奖金额2 + (Range("b" & i).Value - 20) * 0.2) * 10000
  17.         ElseIf Range("b" & i) <= 60 Then
  18.             Range("c" & i) = (奖金额3 + (Range("b" & i).Value - 40) * 0.3) * 10000
  19.         ElseIf Range("b" & i) <= 100 Then
  20.             Range("c" & i) = (奖金额4 + (Range("b" & i).Value - 60) * 0.5) * 10000
  21.         Else
  22.             Range("c" & i) = (奖金额5 + (Range("b" & i).Value - 100) * 0.8) * 10000
  23.         End If
  24.     Next
  25. End Sub
复制代码


点评

全部正确,不错  发表于 2017-8-10 17:19
吃太饱:结果正确, 方法不太理想 如果增加档位 需要大面积修改代码,可参看5楼代码思路  发表于 2017-8-10 17:17
回复 支持 反对

使用道具 举报

发表于 2017-7-28 09:03:23 | 显示全部楼层
本帖最后由 鱼生 于 2017-7-28 11:37 编辑
  1. Sub 作业1() '及格次数可以取消。两种方式,优雅与普通
  2.     Dim 行 As Long, 列 As Long, 不及格次数 As Long, 及格次数 As Long, 优秀次数 As Long
  3.     For 行 = 2 To Range("d2").CurrentRegion.Rows.Count
  4.         优秀次数 = 0
  5.         及格次数 = 0
  6.         不及格次数 = 0
  7.         For 列 = 4 To 9
  8. '            Select Case Cells(行, 列).Value
  9. '                Case Is < 60
  10. '                    不及格次数 = 不及格次数 + 1
  11. '                Case 60 To 84
  12. '                    及格次数 = 及格次数 + 1
  13. '                Case Is >= 85
  14. '                    优秀次数 = 优秀次数 + 1
  15. '            End Select
  16.             If Cells(行, 列).Value >= 85 Then
  17.                 优秀次数 = 优秀次数 + 1
  18. '            ElseIf Cells(行, 列).Value >= 60 Then
  19. '                及格次数 = 及格次数 + 1
  20. '            Else
  21.             ElseIf Cells(行, 列).Value < 60 Then
  22.                 不及格次数 = 不及格次数 + 1
  23.             End If
  24.         Next
  25.             If 不及格次数 = 0 And 优秀次数 < 6 Then Range("k" & 行) = "通过"
  26.             If 优秀次数 = 6 Then Range("k" & 行) = "奖学金"
  27.             If 不及格次数 >= 3 Then
  28.                 Range("k" & 行) = "勒令退学"
  29.             ElseIf 不及格次数 = 2 Then
  30.                 Range("k" & 行) = "留级"
  31.             ElseIf 不及格次数 = 1 Then
  32.                 Range("k" & 行) = "补考"
  33.             End If
  34. '            Select Case 不及格次数
  35. '                Case Is >= 3
  36. '                    Range("k" & 行) = "勒令退学"
  37. '                Case Is = 2
  38. '                    Range("k" & 行) = "留级"
  39. '                Case Is = 1
  40. '                    Range("k" & 行) = "补考"
  41. '            End Select
  42.     Next

  43. End Sub


  44. Sub 作业2() '注释为逐列查找,非注释为逐行查找,两者相反结果相同。
  45.     Dim R As Long, C As Long, N As Long, r1 As Long 'N表示测验一、二、三、四及期末,r1名单中的行数
  46. '        For C = 4 To 8
  47. '            N = N + 3
  48. '            r1 = 2
  49. '            For R = 3 To Range("d3").CurrentRegion.Rows.Count
  50. '                If Cells(R, C).Value < 60 Then
  51. '                    r1 = r1 + 1
  52. '                    Cells(r1, N + 8) = Cells(R, 1).Value
  53. '                    Cells(r1, N + 9) = Cells(R, 3).Value
  54. '                    Cells(r1, N + 10) = Cells(R, C).Value
  55. '                End If
  56. '            Next
  57. '        Next
  58.     For R = 3 To Range("d3").CurrentRegion.Rows.Count
  59.         N = 0
  60.         For C = 4 To 8
  61.             N = N + 3
  62.             If Cells(R, C).Value < 60 Then
  63.                 r1 = Cells(1, N + 8).End(xlDown).Row + 1
  64.                 Cells(r1, N + 8) = Cells(R, 1).Value
  65.                 Cells(r1, N + 9) = Cells(R, 3).Value
  66.                 Cells(r1, N + 10) = Cells(R, C).Value
  67.             End If
  68.          Next
  69.     Next

  70. End Sub

  71. Sub 作业3()
  72.     Dim R As Long
  73.         For R = 2 To Range("b2").CurrentRegion.Rows.Count
  74.             Select Case Cells(R, 2)
  75.                 Case Is <= 10
  76.                     Cells(R, 3) = Cells(R, 2).Value * 0.05 * 10000
  77.                 Case 10 To 20
  78.                     Cells(R, 3) = (10 * 0.05 + (Cells(R, 2).Value - 10) * 0.1) * 10000
  79.                 Case 20 To 40
  80.                     Cells(R, 3) = (10 * 0.05 + 10 * 0.1 + (Cells(R, 2).Value - 20) * 0.2) * 10000
  81.                 Case 40 To 60
  82.                     Cells(R, 3) = (10 * 0.05 + 10 * 0.1 + (Cells(R, 2).Value - 20) * 0.2 + (Cells(R, 2).Value - 40) * 0.3) * 10000
  83.                 Case 60 To 100
  84.                     Cells(R, 3) = (10 * 0.05 + 10 * 0.1 + (Cells(R, 2).Value - 20) * 0.2 + (Cells(R, 2).Value - 40) * 0.3 + (Cells(R, 2).Value - 60) * 0.5) * 10000
  85.                 Case Is > 100
  86.                     Cells(R, 3) = (10 * 0.05 + 10 * 0.1 + (Cells(R, 2).Value - 20) * 0.2 + (Cells(R, 2).Value - 40) * 0.3 + (Cells(R, 2).Value - 60) * 0.5 + (Cells(R, 2).Value - 100) * 0.8) * 10000
  87.                     
  88.             End Select
  89.         Next
  90.    
  91. End Sub
复制代码


最有一题做的不对,40-60万及以上就发多了,思路应该没有问题,只不过值对于发钱(题意)理解不透。感觉自己真的不太适合做会计

点评

作业1-2:正确,赞  发表于 2017-8-10 19:13
作业3:你的计算模型和3楼的比较相似,可以去观摩,我比较主张用5楼的思路方法,如果增加档位 无需大面积修改代码  发表于 2017-8-10 19:12
回复 支持 反对

使用道具 举报

发表于 2017-7-28 10:36:44 | 显示全部楼层
  1. Sub 考试成绩处理()
  2.     Dim i As Long, j As Long, 不及格科目数 As Long, 成绩 As Long, 大于85科目数
  3.     i = 2
  4.         For i = 2 To Range("a1").CurrentRegion.Rows.Count
  5.                 不及格科目数 = 0
  6.                 大于85科目数 = 0
  7.                         For j = 4 To 9
  8.                                 If Cells(i, j) < 60 Then
  9.                  不及格科目数 = 不及格科目数 + 1
  10.                                 End If
  11.              成绩 = Cells(i, j)
  12.                                     If 成绩 >= 85 Then
  13.                                     大于85科目数 = 大于85科目数 + 1
  14.                                      End If
  15.              Next
  16.                                     If 不及格科目数 >= 3 Then
  17.                                             Range("k" & i) = "勒令退学"
  18.                                     ElseIf 不及格科目数 = 2 Then
  19.                                             Range("k" & i) = "留级"
  20.                  ElseIf 不及格科目数 = 1 Then
  21.                                             Range("k" & i) = "补考"
  22.                                     Else
  23.                                             If 大于85科目数 = 6 Then
  24.                                                     Range("k" & i) = "奖学金"
  25.                      Else
  26.                                                     Range("k" & i) = "通过"
  27.                                             End If
  28.                  End If
  29.         Next
  30. End Sub                              
  31.    
复制代码
  1. Sub 不及格学生名单和成绩()
  2.         Dim i As Long, j As Long, n As Long, m As Long, a As Long
  3.         m = 3
  4.             For i = 3 To Range("a3").CurrentRegion.Rows.Count
  5.             n = 0
  6.                     For j = 4 To Range("a3").CurrentRegion.Columns.Count
  7.                             If Cells(i, j) < 60 Then
  8.                                 Cells(m, j + 7 + n) = Cells(i, 1)
  9.                                 Cells(m, j + 8 + n) = Cells(i, 3)
  10.                                 Cells(m, j + 9 + n) = Cells(i, j)
  11.                             End If
  12.              n = n + 2
  13.                     Next
  14.                            For a = 11 To 25
  15.                                   If Cells(m, a) <> "" Then
  16.                                   m = m + 1
  17.                  Exit For
  18.                                   End If
  19.                           Next
  20.             Next
  21. End Sub
复制代码

  1. Sub 吃太饱公司奖金()
  2.         Dim i As Long
  3.                 For i = 2 To Range("a2").CurrentRegion.Rows.Count
  4.                         If Range("b" & i) <= 10 Then
  5.                                 Range("c" & i) = (Range("b" & i) * 0.05) * 10000
  6.                         ElseIf Range("b" & i) > 10 And Range("b" & i) <= 20 Then
  7.                                 Range("c" & i) = (10 * 0.05 + (Range("b" & i) - 10) * 0.1) * 10000
  8.                         ElseIf Range("b" & i) > 20 And Range("b" & i) <= 40 Then
  9.                                 Range("c" & i) = (10 * 0.05 + 10 * 0.1 + _
  10.                                 (Range("b" & i) - 20) * 0.2) * 10000
  11.              ElseIf Range("b" & i) > 40 And Range("b" & i) <= 60 Then
  12.                                 Range("c" & i) = (10 * 0.05 + 10 * 0.1 + 20 * 0.2 _
  13.                                + (Range("b" & i) - 40) * 0.3) * 10000
  14.                         ElseIf Range("b" & i) > 60 And Range("b" & i) <= 100 Then
  15.                                 Range("c" & i) = (10 * 0.05 + 10 * 0.1 + 20 * 0.2 _
  16.                                 + 20 * 0.3 + (Range("b" & i) - 60) * 0.5) * 10000
  17.                         Else
  18.                                 Range("c" & i) = (10 * 0.05 + 10 * 0.1 + 20 * 0.2 _
  19.                                + 20 * 0.3 + 40 * 0.5 + (Range("b" & i) - 100) * 0.8) * 10000
  20.                         End If
  21.                 Next
  22. End Sub
复制代码




点评

作业3:方法不太理想 如果增加档位 需要大面积修改代码,我比较主张用5楼的思路,可以去观摩下  发表于 2017-8-11 10:26
代码缩有待改进,作业2:相同名字的可以不用排在一行的。  发表于 2017-8-11 10:25
全部结果正确  发表于 2017-8-11 10:23
回复 支持 反对

使用道具 举报

发表于 2017-7-28 15:38:21 | 显示全部楼层
Sub 第三题()
Dim i As Long, num As Double
   For i = 2 To Range("a1").CurrentRegion.Rows.Count
   num = Range("b" & i).Value
    If num >= 100 Then
       Range("c" & i) = ((num - 100) * 0.8 + 40 * 0.5 + 20 * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05) * 10000
    ElseIf num >= 60 Then
       Range("c" & i) = ((num - 60) * 0.5 + 20 * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05) * 10000
    ElseIf num >= 40 Then
       Range("c" & i) = ((num - 40) * 0.3 + 20 * 0.2 + 10 * 0.1 + 10 * 0.05) * 1000
    ElseIf num >= 20 Then
        Range("c" & i) = ((num - 20) * 0.2 + 10 * 0.1 + 10 * 0.05) * 10000
    ElseIf num >= 10 Then
       Range("c" & i) = ((num - 10) * 0.1 + 10 * 0.05) * 10000
    Else
       Range("c" & i) = (num * 0.05) * 10000
    End If
Next

End Sub

点评

作业3:方法不太理想 如果增加档位 需要大面积修改代码,我比较主张用5楼的思路,可以去观摩下  发表于 2017-8-11 10:27
回复 支持 反对

使用道具 举报

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

本版积分规则

关闭

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

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