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

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

[复制链接]
发表于 2017-7-28 22:11:53 | 显示全部楼层 |阅读模式
本帖最后由 开心妙妙 于 2017-8-16 16:00 编辑

交作业的要求:

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

使用道具 举报

发表于 2017-7-28 22:45:21 | 显示全部楼层
本帖最后由 CNNNOO 于 2017-7-30 22:11 编辑
  1. Sub CNN第九课时作业题1offsetresize练习作业()
  2.     Dim rng As Range
  3.     Dim RNG2 As Range
  4.     Range("A1:H20").ClearFormats
  5.     Set rng = Range("A1:H1").Offset(5, 0).Resize(Range("A1:H1").Offset(5, 0).CurrentRegion.Rows.Count - 3, Range("A1:H1").Offset(5, 0).CurrentRegion.Columns.Count)
  6.     rng.Interior.Color = vbYellow
  7.     Set RNG2 = Cells(3, "k")
  8.     Set RNG2 = Cells(3, "K").Offset(5, -8).Resize(4, 5)
  9.     Debug.Print RNG2.Address(0, 0)
  10.     RNG2.Font.Color = vbRed
  11.     Range("A5").Offset(1, 3).Resize(Range("A5").Offset(1, 3).CurrentRegion.Rows.Count, Range("A5").Offset(1, 3).CurrentRegion.Columns.Count).Replace 100, "满分"
  12. End Sub
复制代码
  1. Sub CNN第九课时作业题2基础作业练习()
  2.     Dim rng As Range
  3.     Dim i As Long
  4.     Dim J As Long
  5.     Dim 工资 As Long
  6.     Dim 工资2 As Long
  7.     Dim 最低 As Long
  8.     Dim 名次 As Long
  9.     Dim 平均工资 As Long
  10.     Dim 平人 As Long
  11.     J = 2
  12.     名次 = 1
  13.     平均工资 = Application.WorksheetFunction.Average(Range("I2:I9"))
  14.     Set rng = Range("F1").Offset(1, 0).Resize(Range("F1").Offset(1, 0).CurrentRegion.Rows.Count, Range("F1").Offset(1, 0).CurrentRegion.Columns.Count)
  15.     Range("P1:S100").ClearContents
  16.     For i = 2 To rng.CurrentRegion.Rows.Count
  17.         If Cells(i, 7) = "生产" And Cells(i, 8) = "男" Then
  18.             工资 = Cells(i, 9)
  19.             If 最低 = 0 Or 工资 < 最低 Then
  20.                 最低 = 工资
  21.             End If
  22.         End If
  23.         If Cells(i, 6) = "张三达" Then
  24.             工资2 = Cells(i, 9)
  25.         ElseIf 工资2 < Cells(i, 9) Then
  26.             名次 = 名次 + 1
  27.         End If
  28.         If i <= 9 And i >= 2 Then
  29.         End If
  30.         If Cells(i, 9) < 平均工资 And Cells(i, 9) > 0 Then
  31.             平人 = 平人 + 1
  32.         End If
  33.         If Cells(i, 9) > 10000 Then
  34.             Cells(i, 9).Offset(0, -3).Resize(1, 4).Copy Range("P" & J)
  35.             J = J + 1
  36.         End If
  37.     Next
  38.     Cells(3, 10) = 最低
  39.     Cells(3, 11) = 名次
  40.     Cells(3, 12) = 平人
  41. End Sub
复制代码
  1. Sub CNN第九课时作业题3优秀学生人数与名单()
  2.     Dim rng As Range
  3.     Dim i As Long
  4.     Dim j As Long
  5.     Dim N As Long
  6.     Dim 平均分 As Long
  7.     Dim 及格门次 As Long
  8.     Dim 优秀门次 As Long
  9.     N = 3
  10.     Set rng = Range("A1").Offset(1, 0).Resize(Range("A1").Offset(1, 0).CurrentRegion.Rows.Count - 1, Range("A1").Offset(1, 0).CurrentRegion.Columns.Count)
  11.     Range("n1:n100").ClearContents
  12.     For i = 1 To rng.CurrentRegion.Rows.Count
  13.         及格门次 = 0
  14.         优秀门次 = 0
  15.         平均分 = 0
  16.         For j = 1 To rng.CurrentRegion.Columns.Count
  17.             If i + 1 <= rng.CurrentRegion.Rows.Count Then
  18.                 平均分 = Application.WorksheetFunction.Average(Range(Cells(i + 1, 2), Cells(i + 1, 8)))
  19.             End If
  20.             If Range("A1").Offset(i, j) >= 60 Then
  21.                 If Range("A1").Offset(i, j) >= 70 Then
  22.                     优秀门次 = 优秀门次 + 1
  23.                 ElseIf 平均分 >= 75 Then
  24.                     及格门次 = 及格门次 + 1
  25.                 End If
  26.             End If
  27.         Next
  28.         If 优秀门次 = 7 Or 优秀门次 + 及格门次 = 7 Then
  29.             Range("N" & N) = Range("A1").Offset(i, j).Offset(0, -j)
  30.             N = N + 1
  31.         End If
  32.         Range("L3") = N - 3
  33.     Next
  34. End Sub
复制代码

点评

代码这么长,就不行分行嘛,弄得我电脑屏都不够宽了  发表于 2017-8-15 13:40
正确,赞!  发表于 2017-8-15 13:39
回复 支持 反对

使用道具 举报

发表于 2017-7-29 21:59:16 | 显示全部楼层
本帖最后由 师小五 于 2017-7-30 06:33 编辑
  1. <div class="blockcode"><blockquote>Option Explicit

  2. '第一题:
  3. '第一问:背景为黄色的区域range("a6:h12")如何用Range("A1:H1")的Offset属性和Resize属性来表示?
  4. Sub rangeoffsetresize属性1()
  5.     Dim rng As Range
  6.     Set rng = Range("a1:h1").Offset(5, 0).Resize(7, 8)
  7.     Debug.Print rng.Address
  8.    
  9. End Sub

  10. '第二问:字体为红色的区域range("c8:g11")如何用Cells(3,"K")的Offset属性和Resize属性来表示?
  11. Sub rangeoffsetresize属性2()
  12.     Dim rng As Range
  13.     Set rng = Cells(3, "k").Offset(5, -8).Resize(4, 5)
  14.     Debug.Print rng.Address(0, 0)
  15.    
  16. End Sub

  17. '第三问:从A5出发将上表中的所有100分改为"满分"

  18. Sub 满分()
  19.     Dim rng As Range
  20.     Set rng = Cells(5, 1).Offset(1, 3).Resize(7, 5)
  21.     'Debug.Print rng.Address(0, 0)
  22.     rng.Replace 100, "满分"
  23. End Sub



  24. '第二题:
  25. '1 、生产部门男性工资最低的人是谁?
  26. Sub 最低工资()
  27.     Dim i&, j&, name$
  28.     j = 4 ^ 8
  29.     For i = 2 To [f1].CurrentRegion.Rows.Count
  30.         If Cells(i, "g") = "生产" And Cells(i, "h") = "男" Then
  31.             If Cells(i, "i") < j Then
  32.                 j = Cells(i, "i")
  33.                 name = Cells(i, "f")
  34.             End If
  35.          End If
  36.     Next
  37.     MsgBox "生产部门男性工资最低的是:" & name
  38. End Sub
  39. '2、张三达的工资排在所有人工资的第几名
  40. Sub 工资第几名()
  41.     Dim 张三达&, i&, j&
  42.         张三达 = Cells(2, "i")
  43.     For i = 2 To [i1].CurrentRegion.Rows.Count
  44.         If 张三达 <= Cells(i, "i") Then
  45.             j = j + 1
  46.         End If
  47.     Next
  48.     MsgBox "张三达的工资排的在所有人工资的第" & j & "名"
  49. End Sub
  50. '3、有多少人在平均工资以下?
  51. Sub 平均工资以下人数()
  52.     Dim i&, j&, avg&
  53.     For i = 2 To Cells(1, "h").CurrentRegion.Rows.Count
  54.         j = Cells(i, "i") + j
  55.     Next
  56.     avg = j / (Range("h1").CurrentRegion.Rows.Count - 1)
  57.     j = 0
  58.     For i = 2 To [h1].CurrentRegion.Rows.Count
  59.         If Cells(i, "i") < avg Then
  60.             j = j + 1
  61.         End If
  62.     Next
  63.     MsgBox "有" & j & "人工资在平均工资" & avg & "元以下"
  64. End Sub
  65. '4、将工资高于10000的人筛选出来,将结果复制到P至S列。
  66. Sub 复制到P至S列()
  67.     Dim i&, j&
  68.     Range("f1:i1").Copy Range("p1:s1")
  69.     Let j = 1
  70.     For i = 2 To Range("f1").CurrentRegion.Rows.Count
  71.         If Cells(i, "i") >= 10000 Then
  72.             j = j + 1
  73.             Cells(i, "i").Offset(, -3).Resize(1, 4).Copy Cells(j, "p")
  74.             
  75.         End If
  76.     Next

  77. End Sub





  78. '第三题,统计优秀人数,名单
  79. '优秀学生条件:每门功课的成绩均在70及分以上,或者平均分在75分及以上并且没有功课不及格
  80. '成绩60分以下为不及格
  81. Sub 统计优秀人数和名单()
  82.     Dim i&, j&, m&, n&, total&, num&
  83.    
  84.     For i = 2 To [a1].CurrentRegion.Rows.Count  '纵向从行2循环到最后一行
  85.    
  86.         n = 0: num = 0: total = 0     '将变量优秀课目数、不及格课目数、个人总成绩的值归零,进入下一循环

  87.         For j = 2 To [a1].CurrentRegion.Columns.Count   '横向从2列循环到最后一列
  88.            
  89.             If Cells(i, j) >= 70 Then                   '当成绩大于等于70分时,课目n+1
  90.             
  91.                 n = n + 1
  92.                
  93.             ElseIf Cells(i, j) < 60 Then                '当成绩不及格时,不及格课目num+1
  94.             
  95.                 num = num + 1
  96.             
  97.             End If
  98.             
  99.             total = total + Cells(i, j)                 '高斯累加行出该同学的总成绩
  100.             
  101.         Next
  102.         
  103.             total = total \ ([a1].CurrentRegion.Columns.Count - 1) '循环结束后通过总成绩得出平均分
  104.         
  105.         If total >= 75 And num = 0 Or (n = [a1].CurrentRegion.Columns.Count - 1) Then   '两种或条件成立时计数
  106.         
  107.             m = m + 1                               '优秀人数累加计数

  108.             Cells(m + 2, "m") = Cells(i, 1).Value   '对相关单元格赋值
  109.             
  110.             Cells(3, "l") = m
  111.             
  112.         End If
  113.         
  114.       
  115.     Next                '进入下一循环

  116. End Sub

复制代码

点评

结果正确,赞  发表于 2017-8-15 13:45
回复 支持 反对

使用道具 举报

发表于 2017-7-30 12:31:13 | 显示全部楼层
  1. Sub 一()

  2. Dim rng1 As Range
  3.     Set rng1 = Range("A1:H1").Offset(5, 0).Resize(7, 8)
  4. rng1.Interior.Color = vbBlue

  5. End Sub

  6. Sub 二()

  7. Dim rng2 As Range
  8.     Set rng2 = Range("K3").Offset(5, -8).Resize(4, 5)
  9.     rng2.Interior.Color = vbBlue
  10.    
  11. End Sub


  12. Sub 三()

  13. Dim rng3 As Range, rng4 As Range
  14.     Set rng3 = Range("A5").Resize(Range("A5").CurrentRegion.Columns.Count, Range("A5").CurrentRegion.Rows.Count)
  15.     rng3.Replace 100, "满分"
  16.     Debug.Print

  17. End Sub

  18. Sub 工资最低()

  19. Dim i As Long, j As Long, 工资 As Long
  20.     工资 = Range("I2")
  21.     n = 1
  22.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  23.         If Range("I" & i) < 工资 And Range("H" & i) = "男" Then
  24.             工资 = Range("I" & i)
  25.             j = i
  26.         End If
  27.     Next
  28.     MsgBox "生产部门男性工资最低的人是" & Range("F" & j)
  29. End Sub

  30. Sub 张三达排第几()

  31. Dim i As Long, j As Long
  32.     For i = 1 To Range("F1").CurrentRegion.Rows.Count
  33.         If Range("I" & i) > Range("I2") Then
  34.             j = j + 1
  35.         End If
  36.     Next
  37.     MsgBox "张三达的工资排在所有人工资的第" & j & "名"
  38. End Sub

  39. Sub 平均工资以下人数()
  40. Dim i As Long, j As Long, avg As Double, sum As Long
  41.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  42.         sum = sum + Range("I" & i)
  43.     Next
  44.     avg = sum / (Range("F1").CurrentRegion.Rows.Count - 1)
  45.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  46.     If Range("I" & i) < avg Then
  47.         j = j + 1
  48.     End If
  49.     Next
  50.     MsgBox "有" & j & "个人工资在平均工资以下"
  51. End Sub

  52. Sub 工资高于一万()
  53.    
  54.     Dim i As Long, j As Long, rng As Range
  55.         Range("P1:S1") = Range("F1:I1").Value
  56.         j = 2
  57.         For i = 2 To Range("F1").CurrentRegion.Rows.Count
  58.             If Range("I" & i) > 10000 Then
  59.                 Range("P" & j, "S" & j) = Range("F" & i, "I" & i).Value
  60.                 j = j + 1
  61.             End If
  62.         Next
  63. End Sub

  64. Sub 优秀学生名单()
  65. Dim i As Long, j As Long, 分数 As Long, 人数 As Long, n As Long, m As Long
  66.     For i = 2 To Range("A1").CurrentRegion.Rows.Count
  67.         分数 = 0
  68.         n = 0
  69.         m = 0
  70.         For j = 2 To 8
  71.             If Cells(i, j) >= 70 Then
  72.              n = n + 1
  73.             ElseIf Cells(i, j) < 60 Then
  74.                 m = m + 1
  75.              End If
  76.              分数 = 分数 + Cells(i, j)
  77.              Debug.Print 分数
  78.         Next
  79.             If n = 7 Or (m = 0 And 分数 / 7 >= 75) Then
  80.             人数 = 人数 + 1
  81.             Debug.Print 人数
  82.             Range("L3") = 人数
  83.             Cells(2 + 人数, 13) = Cells(i, 1)
  84.             End If
  85.     Next
  86. End Sub
复制代码

点评

其它正确,不错  发表于 2017-8-15 13:59
工资最低代码不正确,结果不正确,要求:生产部门男性工资最低的人是谁,你是得到的结果是男性工资最低  发表于 2017-8-15 13:57
回复 支持 反对

使用道具 举报

发表于 2017-7-30 12:33:05 | 显示全部楼层
  1. Sub 一()

  2. Dim rng1 As Range
  3.     Set rng1 = Range("A1:H1").Offset(5, 0).Resize(7, 8)
  4. rng1.Interior.Color = vbBlue

  5. End Sub

  6. Sub 二()

  7. Dim rng2 As Range
  8.     Set rng2 = Range("K3").Offset(5, -8).Resize(4, 5)
  9.     rng2.Interior.Color = vbBlue
  10.    
  11. End Sub

  12. Sub 三()

  13. Dim rng3 As Range, rng4 As Range
  14.     Set rng3 = Range("A5").Resize(Range("A5").CurrentRegion.Columns.Count, Range("A5").CurrentRegion.Rows.Count)
  15.     rng3.Replace 100, "满分"
  16.     Debug.Print

  17. End Sub

  18. Sub 工资最低()

  19. Dim i As Long, j As Long, 工资 As Long
  20.     工资 = Range("I2")
  21.     n = 1
  22.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  23.         If Range("I" & i) < 工资 And Range("H" & i) = "男" Then
  24.             工资 = Range("I" & i)
  25.             j = i
  26.         End If
  27.     Next
  28.     MsgBox "生产部门男性工资最低的人是" & Range("F" & j)
  29. End Sub

  30. Sub 张三达排第几()

  31. Dim i As Long, j As Long
  32.     For i = 1 To Range("F1").CurrentRegion.Rows.Count
  33.         If Range("I" & i) > Range("I2") Then
  34.             j = j + 1
  35.         End If
  36.     Next
  37.     MsgBox "张三达的工资排在所有人工资的第" & j & "名"
  38. End Sub

  39. Sub 平均工资以下人数()
  40. Dim i As Long, j As Long, avg As Double, sum As Long
  41.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  42.         sum = sum + Range("I" & i)
  43.     Next
  44.     avg = sum / (Range("F1").CurrentRegion.Rows.Count - 1)
  45.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  46.     If Range("I" & i) < avg Then
  47.         j = j + 1
  48.     End If
  49.     Next
  50.     MsgBox "有" & j & "个人工资在平均工资以下"
  51. End Sub
  52. Sub 工资高于一万()
  53.    
  54.     Dim i As Long, j As Long, rng As Range
  55.         Range("P1:S1") = Range("F1:I1").Value
  56.         j = 2
  57.         For i = 2 To Range("F1").CurrentRegion.Rows.Count
  58.             If Range("I" & i) > 10000 Then
  59.                 Range("P" & j, "S" & j) = Range("F" & i, "I" & i).Value
  60.                 j = j + 1
  61.             End If
  62.         Next
  63. End Sub


  64. Sub 优秀学生名单()
  65. Dim i As Long, j As Long, 分数 As Long, 人数 As Long, n As Long, m As Long
  66.     For i = 2 To Range("A1").CurrentRegion.Rows.Count
  67.         分数 = 0
  68.         n = 0
  69.         m = 0
  70.         For j = 2 To 8
  71.             If Cells(i, j) >= 70 Then
  72.              n = n + 1
  73.             ElseIf Cells(i, j) < 60 Then
  74.                 m = m + 1
  75.              End If
  76.              分数 = 分数 + Cells(i, j)
  77.              Debug.Print 分数
  78.         Next
  79.             If n = 7 Or (m = 0 And 分数 / 7 >= 75) Then
  80.             人数 = 人数 + 1
  81.             Debug.Print 人数
  82.             Range("L3") = 人数
  83.             Cells(2 + 人数, 13) = Cells(i, 1)
  84.             End If
  85.     Next
  86. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2017-7-30 15:44:14 | 显示全部楼层
本帖最后由 cynthiashi 于 2017-8-2 12:12 编辑

Sub answer728_作业1_1()

    Dim rng As Range
    Set rng = Range("a1:h1").Offset(5, 0).Resize([a5].CurrentRegion.Rows.Count - 3, [a5].CurrentRegion.Columns.Count)
    rng.Interior.Color = vbYellow

End Sub


Sub answer728_作业1_2()

    Dim rng As Range
    Set rng = Cells(3, "k").Offset(5, -8).Resize(4, 5)
    rng.Font.Color = vbRed

End Sub


Sub answer728_作业1_3()

    Dim rng As Range
    Set rng = [a5].Offset(1, 0).Resize([a5].CurrentRegion.Rows.Count - 3, [a5].CurrentRegion.Columns.Count)
    rng.Replace 100, "满分"

End Sub

Sub answer728_作业2_1()

    Dim dept As Range, gender As Range, rng As Range
    Dim minS As Long, i As Long, xrow As Long
    Set rng = Range(Range("i2"), Range("i" & [f1].CurrentRegion.Rows.Count))
    minS = WorksheetFunction.Max(rng)
    For i = 2 To [f1].CurrentRegion.Rows.Count
        Set dept = Range("G" & i).Find("生产")
        Set gender = Range("h" & i).Find("男")
        If Not dept Is Nothing And Not gender Is Nothing And Range("i" & i) < minS Then
            xrow = i
            minS = Range("i" & i)
        End If
    Next
    MsgBox "生产部门男性工资最低的人是" & Range("f" & xrow)

End Sub



Sub answer728_作业2_2()

    Dim name As Range, i As Long, salary As Long
    Dim j As Long, num As Long
    For i = 2 To [f1].CurrentRegion.Rows.Count
        Set name = Range("f" & i).Find("张三达")
        If Not name Is Nothing Then
            salary = Range("i" & i)
        Else
            Exit For
        End If
    Next
    num = 1
    For j = 2 To [f1].CurrentRegion.Rows.Count
        If Range("i" & j).Value > salary Then
            num = num + 1
        End If
    Next
    MsgBox "张三达的工资排在所有人工资的第" & num & "名"

End Sub




Sub answer728_作业2_3()

    Dim i As Long, num As Long
    Dim rng As Range, average As Double
    Set rng = Range("i2:i9")
    average = WorksheetFunction.average(rng)
    For i = 2 To [f1].CurrentRegion.Rows.Count
        If Range("i" & i).Value < average Then num = num + 1
    Next
    MsgBox "有" & num & "人在平均工资以下"

End Sub



Sub answer728_作业2_4()

    Dim i As Long, rng As Range, xrow As Long
    xrow = 1
    Range([f1], [i1]).Copy
    Range("p1").Select
    ActiveSheet.Paste
    For i = 2 To [f1].CurrentRegion.Rows.Count
        If Range("i" & i) > 10000 Then
            Set rng = Range(Range("f" & i), Range("i" & i))
            xrow = xrow + 1
            rng.Copy
            Range("p" & xrow).Select
            ActiveSheet.Paste
        End If
    Next

End Sub


Sub answer728_作业3()
    Dim i&, j&, num1 As Long, num2 As Long, xrow As Long, rng As Range, xaverage As Double
    xrow = 2
    For i = 2 To [a1].CurrentRegion.Rows.Count
         num1 = 0
         num2 = 0
         Set rng = Range(Cells(i, "b"), Cells(i, [a1].CurrentRegion.Columns.Count))
         xaverage = WorksheetFunction.Average(rng)
         For j = 2 To [a1].CurrentRegion.Columns.Count
             If Cells(i, j) >= 70 Then
                 num1 = num1 + 1
             ElseIf Cells(i, j) < 60 Then
                 num2 = num2 + 1
             End If
         Next
         If num1 = [a1].CurrentRegion.Columns.Count - 1 Or (xaverage >= 75 And num2 = 0) Then
             xrow = xrow + 1
             Range("a" & i).Copy Range("m" & xrow)
         End If
    Next
    Range("l3") = xrow - 2
         
End Sub





点评

全部正确,赞  发表于 2017-8-15 14:04
回复 支持 反对

使用道具 举报

发表于 2017-7-30 17:24:43 | 显示全部楼层
  1. '作业1: offset-resize练习
  2. Sub offsetresize练习1()
  3.     Dim 黄色背景区域 As Range, 红色字体区域 As Range
  4.     Set 黄色背景区域 = Range("a1:h1").Offset(5, 0).Resize(7, 8)
  5.     Set 红色字体区域 = Cells(3, "k").Offset(5, -8).Resize(4, 5)
  6. End Sub

  7. Sub 将一百分改为满分()
  8.     Dim rng As Range
  9.     Set rng = Range("a5").Offset(1, 3).Resize(7, 5)
  10.     rng.Replace 100, "满分"
  11. End Sub


  12. '作业2: 基础作业练习
  13. Sub 男性最低工资()
  14.     Dim i As Long, j As Long, min As Long
  15.     min = 11751
  16.     For i = 3 To 9
  17.         If Cells(i, "g") = "生产" And Cells(i, "h") = "男" And Cells(i, "i") < min Then
  18.             min = Cells(i, "i")
  19.             j = i
  20.         End If
  21.     Next
  22.     MsgBox "生产部门男性工资最低的人是" & Cells(j, "f")
  23. End Sub

  24. Sub 工资排名()
  25.     Dim i As Long, j As Long
  26.     For i = 3 To 9
  27.         If Cells(i, "i") > 11751 Then
  28.         j = j + 1
  29.         End If
  30.     Next
  31.     MsgBox "张三达的工资排在所有人工资的第" & j + 1 & "名"
  32. End Sub
  33. Sub 低于平均工资人数()
  34.     Dim 总工资 As Long, 平均工资 As Double, i As Long, j As Long
  35.     For i = 2 To 9
  36.         总工资 = 总工资 + Cells(i, "i")
  37.     Next
  38.     平均工资 = 总工资 / 8
  39.     For i = 2 To 9
  40.         If Cells(i, "i") < 平均工资 Then
  41.             j = j + 1
  42.         End If
  43.     Next
  44.     MsgBox "低于平均工资的有" & j & "人"
  45. End Sub

  46. Sub 工资高于一万的名单()
  47.     Dim i As Long, j As Long
  48.     j = 2
  49.     For i = 2 To 9
  50.         If Cells(i, "i") > 10000 Then
  51.             Cells(j, "p") = Cells(i, "f")
  52.             Cells(j, "q") = Cells(i, "g")
  53.             Cells(j, "r") = Cells(i, "h")
  54.             Cells(j, "s") = Cells(i, "i")
  55.             j = j + 1
  56.         End If
  57.     Next
  58. End Sub



  59. '作业3: 优秀学生人数与名单
  60. Sub 优秀学生人数和名单()
  61.     Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
  62.     n = 3
  63.     For i = 2 To 17
  64.         For j = 2 To 8
  65.             Cells(i, "i") = Cells(i, "i") + Cells(i, j)
  66.             If Cells(i, j) >= 70 Then k = k + 1
  67.             If Cells(i, j) < 60 Then l = l + 1
  68.         Next
  69.     Cells(i, "i") = Cells(i, "i") / 7
  70.     If k = 7 Or (Cells(i, "i") >= 75 And l = 0) Then
  71.         m = m + 1
  72.         Cells(n, "m") = Cells(i, "a")
  73.         n = n + 1
  74.     End If
  75.     k = 0
  76.     l = 0
  77.     Next
  78.     Cells(3, "l") = m
  79. End Sub
复制代码

点评

正确,赞  发表于 2017-8-15 16:57
回复 支持 反对

使用道具 举报

发表于 2017-7-30 21:08:19 | 显示全部楼层
  1. Sub 作业1offse和resize练习第问()
  2.         Dim i As Range
  3.    
  4.         Set i = Range("A1:H1").Offset(5, 0).Resize(Range("A5").CurrentRegion.Rows.Count - 3, _
  5.         Range("A5").CurrentRegion.Columns.Count) '从A1:H1向下平移5行,高度为7

  6.         i.Interior.Color = 13020235 '数字是目标颜色的代码
  7.    
  8. End Sub
复制代码

  1. Sub 作业1第二问()

  2.         Dim i As Range
  3.    
  4.         Set i = Range("K3").Offset(5, -8).Resize(4, 5)
  5.    
  6.         i.Interior.Color = 5296274

  7. End Sub
复制代码
  1. Sub 作业1第三问()
  2.         Dim i As Range
  3.    
  4.         Set i = Range("A5").Offset(1, 3).Resize(Range("A5").CurrentRegion.Rows.Count - 3, Range("A5").CurrentRegion.Columns.Count - 3)
  5.      
  6.          i.Replace 100, "满分"

  7. End Sub
复制代码


  1. Sub 作业3优秀学生人数与名单()
  2.         Dim i&, j&, chi&, sum&, chi1&, p&
  3.    
  4.         p = 3 '从第三行开始写数据
  5.    
  6.         For i = 2 To Range("A1").CurrentRegion.Rows.Count
  7.    
  8.                 For j = 2 To Range("A1").CurrentRegion.Columns.Count
  9.         
  10.                         sum = sum + Cells(i, j) '累加分数
  11.         
  12.                         If Cells(i, j) >= 70 Then
  13.             
  14.                                 chi = chi + 1 '计算大于等于70的次数
  15.                  
  16.                         End If
  17.             
  18.                        If Cells(i, j) < 60 Then
  19.             
  20.                                     chi1 = chi1 + 1 '计算不及格的次数
  21.                
  22.                        End If
  23.                
  24.                 Next
  25.         
  26.                If chi = 7 Or (sum / 7 >= 75 And chi1 = 0) Then
  27.          
  28.                         Cells(p, "M") = Cells(i, "A")
  29.             
  30.                          p = p + 1
  31.             
  32.                         Cells(3, "l") = Cells(3, "l") + 1
  33.             
  34.                End If
  35.         
  36.               chi = 0
  37.               chi1 = 0
  38.               sum = 0
  39.    
  40.         Next
  41.         
  42. End Sub
复制代码
  1. Sub 作业2第一问()

  2.         Dim i&, 姓名$, sum&
  3.    
  4.         sum = 4 ^ 8 '初值设置一个较大的数值,保证第一次判断能够进入IF
  5.    
  6.         For i = 2 To Range("F1").CurrentRegion.Rows.Count
  7.         
  8.                 If Cells(i, "h") = "男" Then '先判断是否为男
  9.         
  10.                         If Cells(i, "i") < sum Then '打擂台
  11.             
  12.                                 sum = Cells(i, "i")
  13.                                姓名 = Cells(i, "F")
  14.             
  15.                       End If
  16.         
  17.                 End If
  18.    
  19.     Next
  20.    
  21.     MsgBox "生产部门男性工资最低的人是" & 姓名

  22. End Sub
复制代码
  1. Sub 作业2第二问()

  2.     Dim i&, min&
  3.    
  4.     min = 1 '李三达本身的工资也占了一个排名的位置。
  5.    
  6.     For i = 3 To Range("F1").CurrentRegion.Rows.Count
  7.    
  8.         If Cells(i, "i") > Cells(2, "i") Then '比李三达工资高,则李三达的排名增加1,否则不做任何处理。
  9.         
  10.             min = min + 1
  11.             
  12.         End If
  13.         
  14.     Next
  15.    
  16.     MsgBox "张三达的工资排在所有人工资的第" & min & "名"
  17.    
  18. End Sub
  19. Sub 作业2第三问()

  20.     Dim i&, sum&, chi&, j&, sum1&
  21.    
  22.     For j = 2 To Range("F1").CurrentRegion.Rows.Count
  23.    
  24.         For i = 2 To Range("F1").CurrentRegion.Rows.Count
  25.         
  26.         sum = sum + Cells(i, "i")
  27.         chi = chi + 1
  28.         
  29.         Next
  30.         
  31.         If Cells(j, "i") < sum / chi Then
  32.         
  33.             sum1 = sum1 + 1
  34.             
  35.         End If
  36.         
  37.     Next
  38.    
  39.     MsgBox "有" & sum1 & "人在平均工资以下"

  40. End Sub
复制代码
  1. Sub 作业2第四问()

  2.     Dim i&, j&
  3.    
  4.     Range("F1:I1").Select
  5.     Selection.Copy
  6.     Range("p1").Select
  7.     ActiveSheet.Paste
  8.     Range("s1").Select
  9.    
  10.     j = 2
  11.    
  12.     For i = 2 To Range("F1").CurrentRegion.Rows.Count
  13.    
  14.         If Cells(i, "i") > 10000 Then
  15.         
  16.             Range("F" & i & ":" & "i" & i).Select
  17.             Selection.Copy
  18.             Range("p" & j).Select
  19.             ActiveSheet.Paste
  20.             Range("s" & j).Select
  21.             j = j + 1
  22.             
  23.         End If
  24.    
  25.     Next
  26.    
  27. End Sub
复制代码





点评

其它结果正确,不错  发表于 2017-8-16 15:40
作业2第一问,不正确,条件是生产部的男性,你只有男性的条件  发表于 2017-8-16 15:37
回复 支持 反对

使用道具 举报

发表于 2017-7-30 23:08:42 | 显示全部楼层
'背景为黄色区域 Range("A1:H1").Offset(5, 0).Resize(7, 8).Select
'字体为红色区域 Cells(3, "k").Offset(5, -8).Resize(4, 5)

Sub 作业1()
Range("A5").Offset(1, 3).Resize(7, 5).Replace 100, "满分"
End Sub

Sub 生产部门男性工资最低的人()
Dim h As Long, m As Long, zd As String
    m = Range("i2")
For h = 2 To Range("i2").CurrentRegion.Rows.Count
    If Range("g" & h) = "生产" And Range("h" & h) = "男" Then
        If Range("i" & h) < m Then
        m = Range("i" & h)
        zd = Range("f" & h)
        End If
    End If
Next
    MsgBox "生产部门男性工资最低的人是" & zd
End Sub

Sub 张三达()
Dim h As Long, m As Long, k As Long
    m = Range("i2")
    k = 1
For h = 2 To Range("i2").CurrentRegion.Rows.Count
    Select Case Range("i" & h)
    Case Is > m
        k = k + 1
    End Select
    Next
    MsgBox "张三达的工资排在所有人工资的第" & k & "名"
End Sub


Sub 平均工资()
Dim h As Long, sum As Double, k As Long, n As Long, p As Double
For h = 2 To Range("i2").CurrentRegion.Rows.Count
    sum = sum + Range("i" & h)
    k = k + 1
    Next
p = sum / k
For h = 2 To Range("i2").CurrentRegion.Rows.Count
    Select Case Range("i" & h)
    Case Is < p
    n = n + 1
    End Select
    Next
    MsgBox "有" & n & "人在平均工资以下"
End Sub




Sub 大于10000()
Dim h As Long, n As Long
Range("f1:i1").Copy Range("p1:s1")
n = 2
For h = 2 To Range("i2").CurrentRegion.Rows.Count
    Select Case Range("i" & h)
    Case Is > 10000
        Range("f" & h & ":" & "i" & h).Copy Range("p" & n & ":" & "s" & n)
        n = n + 1
End Select
Next
End Sub

Sub 作业3()
Dim h As Long, l As Long, k As Long, n As Long, p As Long, s As Long
s = 3
For h = 2 To Range("a1").CurrentRegion.Rows.Count
n = 0
k = 0
    For l = 2 To Range("a1").CurrentRegion.Columns.Count
    Select Case Cells(h, l)
    Case Is >= 70
    k = k + 1
    Case Is < 60
    n = n + 1
    End Select
  Next
    p = (Cells(h, 2) + Cells(h, 3) + Cells(h, 4) + Cells(h, 5) + Cells(h, 6) + Cells(h, 7) + Cells(h, 8)) / 7
    If k = 7 Or (p > 75 And n = 0) Then
    Range("l3") = Range("l3") + 1
    Range("m" & s) = Range("a" & h)
    s = s + 1
    End If
    Next
End Sub


点评

正确,不错  发表于 2017-8-16 15:49
回复 支持 反对

使用道具 举报

发表于 2017-7-31 12:11:45 | 显示全部楼层
学员号:枫叶950200
  1. Sub 作业1Offset蓝色找黄色练习()
  2.     Sheet3.Activate
  3.     Dim rng As Range
  4.    
  5.     Set rng = Range("A1:H1").Offset(5, 0).Resize(7, [A5].CurrentRegion.Columns.Count)
  6.     rng.Select
  7. End Sub

  8. Sub 作业1Offset绿色找红色练习()
  9.     Sheet3.Activate
  10.     Dim rng As Range
  11.    
  12.     Set rng = Range("K3").Offset(5, -8).Resize(4, 5)
  13.     rng.Select
  14. End Sub

  15. Sub 作业1Offset换满分()
  16.     Sheet3.Activate
  17.     Dim rng As Range
  18.    
  19.     Set rng = Range("A5").Offset(1, 3).Resize(7, 5)
  20.     rng.Replace 100, "满分"
  21. End Sub
复制代码
  1. Sub 作业2循环联系()
  2.     Sheet4.Activate
  3.     Dim 工资 As Double
  4.     Dim 行 As Long, 次 As Long
  5.     Dim rng As Range
  6.    
  7.    Set rng = Range("F2", "I" & Range("F1").End(xlDown).End(xlToRight).Row)
  8.    '定义对象为单元格区域
  9.     For 行 = 2 To rng.Rows.Count + 1
  10.         If Range("H" & 行) = "男" And (Range("i" & 行) <= 工资 Or 工资 = 0) Then
  11.             '如果性别等于男并且遍历的工资小于等于工资或工资等于0就
  12.             工资 = Range("I" & 行)
  13.             次 = 行
  14.         End If
  15.     Next
  16.     MsgBox "男性最低工资为" & Range("F" & 次)
  17.    
  18.     次 = 1
  19.     For 行 = 2 To rng.Rows.Count + 1
  20.         If Range("F" & 行) <> "张三达" And Range("I" & 行) > Range("I2") Then
  21.         '如果姓名不等于张三达并且遍历的工资大于I2的工资
  22.             次 = 次 + 1
  23.         End If
  24.     Next
  25.     MsgBox "张三达的工资排在所有人工资的第" & 次 & "名"

  26.     工资 = 0
  27.     次 = 0
  28.     For 行 = 2 To rng.Rows.Count + 1
  29.         工资 = 工资 + Range("I" & 行)
  30.         '工资加总
  31.         次 = 次 + 1
  32.     Next
  33.     工资 = 工资 / 次
  34.     次 = 0
  35.     For 行 = 2 To rng.Rows.Count + 1
  36.         If Range("I" & 行) < 工资 Then 次 = 次 + 1
  37.         '如果遍历的工资小于平均工资就次数+1
  38.     Next
  39.     MsgBox "有" & 次 & "人在平均工资" & 工资 & "以下"
  40.    
  41.     次 = 2
  42.     Range("P1", "S1").Value = Range("F1", "I1").Value
  43.     '表头复制
  44.     For 行 = 2 To rng.Rows.Count + 1
  45.         If Range("I" & 行) > 10000 Then
  46.             Range("P" & 次, "S" & 次).Value = Range("F" & 行, "I" & 行).Value
  47.             '工资大于10000就复制单元格数字
  48.             次 = 次 + 1
  49.         End If
  50.     Next

  51. End Sub
复制代码
  1. Sub 作业3优秀学生()
  2.     Dim i1 As Long, i2 As Long
  3.     Dim L1 As Long, L2 As Long
  4.     Dim 成绩 As Double, 优秀 As Long
  5.     For i1 = 2 To Range("A1").End(xlDown).Row
  6.     '外循环行数,2行到最后一行
  7.         For i2 = 2 To Range("A1").End(xlToRight).Column
  8.         '内循环列数,2列到最后1列
  9.             Select Case Cells(i1, i2).Value '判断单元格数值
  10.                 Case Is >= 70
  11.                     L1 = L1 + 1 '优秀成绩次数L1+1
  12.                     L2 = L2 + 1 '合格成绩次数L2+1
  13.                     成绩 = 成绩 + Cells(i1, i2).Value
  14.                 Case Is >= 60
  15.                     成绩 = 成绩 + Cells(i1, i2).Value '累加成绩
  16.                     L2 = L2 + 1 '合格成绩次数+1
  17.                 Case Else
  18.                     L2 = -1 '将合格成绩次数赋值为-1,避免为0无法计算平均成绩
  19.                     Exit For '找到有不合格成绩的直接退出内循环
  20.             End Select
  21.         Next
  22.             成绩 = 成绩 / L2 '计算平均成绩
  23.             If 成绩 >= 75 Or L1 = L2 Then
  24.             '如果平均成绩大于75或成绩70分的次数与合格成绩次数一样的
  25.                 优秀 = 优秀 + 1
  26.                 Cells(优秀 + 2, 13).Value = Cells(i1, 1).Value
  27.             End If
  28.             L1 = 0: L2 = 0: 成绩 = 0 '清空变量,开始计算下一行
  29.     Next
  30.         Range("L3").Value = 优秀
  31. End Sub
复制代码


点评

其它结果正确,赞  发表于 2017-8-16 15:59
作业2第1问不正确,求的是生产部男性最低工资,你求的结果是男性最低工资,少了生产部门的条件  发表于 2017-8-16 15:59
回复 支持 反对

使用道具 举报

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

本版积分规则

关闭

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

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