白话Excel函数公式 Office易学宝微视频教程合集(Excel+Word+PPT)
笨办法学VBA(从入门到精通) 高效办公必会的Office实战技巧
财务总监的Excel私房课 Excel数据透视表实战秘技
Excel图表神技
12
返回列表 发新帖
楼主: 唐伯狼

零基础13期-第九课作业

[复制链接]
发表于 2018-3-27 22:13:59 | 显示全部楼层

  1. 第九课作业


  2. 周末作业1
  3. Sub 选科非选科等级()
  4.     Dim i As Long, m As Long, area As Range
  5.     Set area = Range("a1").CurrentRegion
  6.     For i = 2 To area.Rows.Count
  7.         If Cells(i, 1) = 2 Or Cells(i, 1) = 3 Or Cells(i, 1) = 5 Or Cells(i, 1) = 6 Then
  8.                 If Cells(i, 3) >= 85 Then
  9.                 Cells(i, 4) = "优秀"
  10.                 ElseIf Cells(i, 3) >= 70 Then
  11.                 Cells(i, 4) = "合格"
  12.                 Else
  13.                 Cells(i, 4) = "不及格"
  14.                 End If
  15.                
  16.                 For m = 5 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
  17.                 If Cells(i, m) >= 80 Then
  18.                 Cells(i, m + 1) = "优秀"
  19.                 ElseIf Cells(i, m) >= 60 Then
  20.                 Cells(i, m + 1) = "合格"
  21.                 Else
  22.                 Cells(i, m + 1) = "不及格"
  23.                 End If
  24.                 Next
  25.         Else
  26.                 For m = 3 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
  27.                 If Cells(i, m) >= 80 Then
  28.                 Cells(i, m + 1) = "优秀"
  29.                 ElseIf Cells(i, m) >= 60 Then
  30.                 Cells(i, m + 1) = "合格"
  31.                 Else
  32.                 Cells(i, m + 1) = "不及格"
  33.                 End If
  34.                 Next
  35.         End If
  36.     Next
  37.    
  38. End Sub



  39. 周末作业2

  40. Sub 产品总量()
  41.     Dim i As Long, j As Long, m As Long, n As Long, area1 As Range, area2 As Range
  42.     Set area1 = Range("a1").CurrentRegion
  43.     j = 1
  44.     For i = 2 To area1.Rows.Count
  45.         If Cells(i, 1) <> "" Then
  46.             j = j + 1
  47.             Cells(j, 6) = Cells(i, 1)
  48.             Cells(j, 7) = Cells(i, 2)
  49.         Else
  50.             Cells(j, 7) = Cells(j, 7) + Cells(i, 2)
  51.         End If
  52.     Next
  53.    
  54.     Set area2 = Range("f1").CurrentRegion
  55.    
  56.     For n = 2 To area2.Rows.Count
  57.     m = n + 1
  58.     Do While m <= area2.Rows.Count
  59.    
  60.     If Cells(n, 6) = Cells(m, 6) Then
  61.     Cells(n, 7) = Cells(n, 7) + Cells(m, 7)
  62.     area2.Rows(m).Delete xlShiftUp
  63.    
  64.     Else
  65.     m = m + 1
  66.     End If
  67.     Loop
  68.    
  69.     Next
  70.    
  71.    
  72. End Sub



  73. 第一题

  74. 第一问
  75. Sub 练习()

  76. Dim area As Range, m As Long, n As Long

  77. Set area = Range("a5").CurrentRegion
  78. n = area.Rows.Count
  79. m = area.Columns.Count

  80. Range("A1:H1").Offset(5, 0).Resize(n - 3, m).Select

  81. 'Range("A1:H1").Offset(5, 0).Resize(n - 3, m).Interior.Color = vbBlue

  82. End Sub


  83. 第二问
  84. Sub 练习()

  85. Cells(3, "K").Offset(5, -8).Resize(4, 5).Select

  86. End Sub


  87. 第三问

  88. Sub 练习()

  89. Cells(5, "a").Offset(1, 3).Resize(7, 5).Replace 100, "满分"


  90. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-3-27 22:16:23 | 显示全部楼层
  1. 第二题

  2. 第一问

  3. Sub 基础练习()

  4. Dim i As Long, a As Long, n As Long, m As Long

  5. a = Range("f1").CurrentRegion.Rows.Count

  6. For i = 1 To a
  7. If Cells(i, "h") = "男" Then
  8. n = Cells(i, "i")
  9. Exit For
  10. End If
  11. Next

  12. For i = 1 To a
  13.     If Cells(i, "h") = "男" Then
  14.     If Cells(i, "i") < n Then
  15.     n = Cells(i, "i")
  16.     m = i
  17.     End If
  18.     End If
  19. Next

  20. MsgBox "生产部门男性工资最低的人是" & Cells(m, "f") & vbCr _
  21.        & "最低工资是" & n & "元"

  22. End Sub

  23. 第二问

  24. Sub 基础练习()

  25. Dim i As Long, a As Long, n As Long, m As Long

  26. a = Range("f1").CurrentRegion.Rows.Count

  27. n = Cells(2, "i")

  28. For i = 2 To a
  29.     If Cells(i, "i") >= n Then
  30.     m = m + 1
  31.     End If
  32. Next

  33. MsgBox "张三达的工资排在所有人工资的第" & m & "名"

  34. End Sub

  35. 第三问

  36. Sub 基础练习()

  37. Dim i As Long, a As Long, n As Long, m As Long, x As Long, y As Double

  38. a = Range("f1").CurrentRegion.Rows.Count

  39. For i = 2 To a
  40.     n = n + Cells(i, "i")
  41.     m = m + 1
  42. Next

  43. y = n / m

  44. For i = 2 To a
  45.     If Cells(i, "i") < y Then
  46.     x = x + 1
  47.     End If
  48. Next

  49. MsgBox "有" & x & "人在平均工资以下"

  50. End Sub

  51. 第四问

  52. Sub 基础练习()

  53. Dim i As Long, a As Long, n As Long, x As Long

  54. a = Range("f1").CurrentRegion.Rows.Count

  55. For i = 2 To a
  56.     If Cells(i, "i") >= 10000 Then
  57.     n = n + 1
  58.     Cells(n, "p") = Cells(i, "f")
  59.     End If
  60. Next

  61. For i = 1 To Range("p1").CurrentRegion.Rows.Count
  62. For x = 16 To 19
  63. Cells(i, x) = Cells(i, 16)
  64. Next
  65. Next

  66. End Sub


  67. 第三题

  68. Sub 基础练习()

  69. Dim a As Long, b As Long, x As Long, y As Long, n As Long, m As Long, 总成绩 As Long, 平均成绩 As Long, z As Long

  70. a = Range("a1").CurrentRegion.Rows.Count
  71. b = Range("a1").CurrentRegion.Columns.Count
  72. z = 3
  73.     For x = 2 To a
  74.     n = 0
  75.     m = 0
  76.     总成绩 = 0
  77.         For y = 2 To b

  78.             If Cells(x, y) >= 70 Then
  79.             n = n + 1
  80.             End If

  81.             If Cells(x, y) < 60 Then
  82.             m = m + 1
  83.             End If

  84.             总成绩 = 总成绩 + Cells(x, y)
  85.             平均成绩 = 总成绩 / (b - 1)
  86.         Next

  87.         If n = b - 1 Then
  88.         Cells(z, "m") = Cells(x, 1)
  89.         z = z + 1
  90.         ElseIf 平均成绩 >= 75 And m = 0 Then
  91.         Cells(z, "m") = Cells(x, 1)
  92.         z = z + 1
  93.         End If

  94.     Next
  95.     Cells(3, "l") = z - 3
  96.    
  97. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-3-27 22:21:35 | 显示全部楼层
  1. 第九课作业


  2. 周末作业1
  3. Sub 选科非选科等级()
  4.     Dim i As Long, m As Long, area As Range
  5.     Set area = Range("a1").CurrentRegion
  6.     For i = 2 To area.Rows.Count
  7.         If Cells(i, 1) = 2 Or Cells(i, 1) = 3 Or Cells(i, 1) = 5 Or Cells(i, 1) = 6 Then
  8.                 If Cells(i, 3) >= 85 Then
  9.                 Cells(i, 4) = "优秀"
  10.                 ElseIf Cells(i, 3) >= 70 Then
  11.                 Cells(i, 4) = "合格"
  12.                 Else
  13.                 Cells(i, 4) = "不及格"
  14.                 End If
  15.                
  16.                 For m = 5 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
  17.                 If Cells(i, m) >= 80 Then
  18.                 Cells(i, m + 1) = "优秀"
  19.                 ElseIf Cells(i, m) >= 60 Then
  20.                 Cells(i, m + 1) = "合格"
  21.                 Else
  22.                 Cells(i, m + 1) = "不及格"
  23.                 End If
  24.                 Next
  25.         Else
  26.                 For m = 3 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
  27.                 If Cells(i, m) >= 80 Then
  28.                 Cells(i, m + 1) = "优秀"
  29.                 ElseIf Cells(i, m) >= 60 Then
  30.                 Cells(i, m + 1) = "合格"
  31.                 Else
  32.                 Cells(i, m + 1) = "不及格"
  33.                 End If
  34.                 Next
  35.         End If
  36.     Next
  37.    
  38. End Sub



  39. 周末作业2

  40. Sub 产品总量()
  41.     Dim i As Long, j As Long, m As Long, n As Long, area1 As Range, area2 As Range
  42.     Set area1 = Range("a1").CurrentRegion
  43.     j = 1
  44.     For i = 2 To area1.Rows.Count
  45.         If Cells(i, 1) <> "" Then
  46.             j = j + 1
  47.             Cells(j, 6) = Cells(i, 1)
  48.             Cells(j, 7) = Cells(i, 2)
  49.         Else
  50.             Cells(j, 7) = Cells(j, 7) + Cells(i, 2)
  51.         End If
  52.     Next
  53.    
  54.     Set area2 = Range("f1").CurrentRegion
  55.    
  56.     For n = 2 To area2.Rows.Count
  57.     m = n + 1
  58.     Do While m <= area2.Rows.Count
  59.    
  60.     If Cells(n, 6) = Cells(m, 6) Then
  61.     Cells(n, 7) = Cells(n, 7) + Cells(m, 7)
  62.     area2.Rows(m).Delete xlShiftUp
  63.    
  64.     Else
  65.     m = m + 1
  66.     End If
  67.     Loop
  68.    
  69.     Next
  70.    
  71.    
  72. End Sub



  73. 第一题

  74. 第一问
  75. Sub 练习()

  76. Dim area As Range, m As Long, n As Long

  77. Set area = Range("a5").CurrentRegion
  78. n = area.Rows.Count
  79. m = area.Columns.Count

  80. Range("A1:H1").Offset(5, 0).Resize(n - 3, m).Select

  81. 'Range("A1:H1").Offset(5, 0).Resize(n - 3, m).Interior.Color = vbBlue

  82. End Sub


  83. 第二问
  84. Sub 练习()

  85. Cells(3, "K").Offset(5, -8).Resize(4, 5).Select

  86. End Sub


  87. 第三问

  88. Sub 练习()

  89. Cells(5, "a").Offset(1, 3).Resize(7, 5).Replace 100, "满分"


  90. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-4-2 23:00:20 | 显示全部楼层

  1. Sub 重做吃太饱作业3循环()
  2.     Dim i As Long, 利润 As Double, 提成 As Double, 未提成 As Double
  3.    
  4.     For i = 2 To Range("a2").CurrentRegion.Rows.Count
  5.     利润 = Cells(i, 2)
  6.     未提成 = 利润
  7.     提成 = 0
  8.       
  9.     Do While 未提成 > 0
  10.         Select Case 未提成
  11.         Case Is > 100
  12.             提成 = 提成 + (未提成 - 100) * 0.8
  13.             未提成 = 100
  14.         Case Is > 60
  15.             提成 = 提成 + (未提成 - 60) * 0.5
  16.             未提成 = 60
  17.         Case Is > 40
  18.             提成 = 提成 + (未提成 - 40) * 0.3
  19.             未提成 = 40
  20.          Case Is > 20
  21.             提成 = 提成 + (未提成 - 20) * 0.2
  22.             未提成 = 20
  23.         Case Is > 10
  24.             提成 = 提成 + (未提成 - 10) * 0.1
  25.             未提成 = 10
  26.         Case Else
  27.             提成 = 提成 + 未提成 * 0.05
  28.             未提成 = 0
  29.         
  30.         End Select
  31.     Loop
  32.     Cells(i, 3) = 提成 * 10000
  33.    
  34.     Next
  35. End Sub
  36. Sub 作业1offsetresize练习作业1()
  37.     Dim rng1 As Range, rng2 As Range
  38.    
  39.     Set rng1 = Range("a1:h1")
  40.     Set rng2 = rng1.Offset(5, 0).Resize(7, 8)
  41.     rng1.Select
  42.     Selection.Copy
  43.     rng2.Select
  44.     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  45.    

  46. End Sub

  47. Sub 作业1offsetresize练习作业2()
  48.     Dim rng1 As Range, rng2 As Range
  49.    
  50.     Set rng1 = Cells(3, "K").Offset(5, -8)
  51.     rng1.Select
  52.     Set rng2 = rng1.Resize(4, 5)
  53.    
  54.     Cells(3, "K").Select
  55.     Selection.Copy
  56.     rng2.Select
  57.     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  58.    

  59. End Sub
  60. Sub 作业1offsetresize练习作业3()
  61.   
  62.      Range("a5").CurrentRegion.Replace 100, "满分"

  63. End Sub

  64. Sub 作业2_1生产部门男性工资最低的人是谁()
  65.     Dim i As Long, 工资 As Long, 最低工资 As Long, 最低工资的人 As String
  66.    
  67.    
  68.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  69.         If Cells(i, "H") = "男" And Cells(i, "G") = "生产" Then
  70.             工资 = Cells(i, "I")
  71.             If 工资 < 最低工资 Then
  72.                 最低工资 = 工资
  73.             Else
  74.                 最低工资 = 最低工资
  75.                 最低工资的人 = Cells(i, "F")
  76.             End If
  77.         End If
  78.         
  79.         
  80.     Next
  81.     MsgBox "最低工资的人是" & 最低工资的人
  82. End Sub
  83. Sub 作业2_2张三达的工资排在所有人工资的第几名()
  84.     Dim i As Long, j As Long, 工资 As Long
  85.         工资 = Cells(2, "I")
  86.         j = 1
  87.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  88.         If Cells(i, "I") > 工资 Then
  89.             
  90.             j = j + 1
  91.             
  92.         End If
  93.         
  94.         
  95.     Next
  96.     MsgBox "张三达的工资排在所有人工资的第" & j & "名"
  97. End Sub

  98. Sub 作业2_3有多少人在平均工资以下()
  99.     Dim i As Long, sum As Long, j As Long, ave As Double
  100.         
  101.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  102.         sum = sum + Cells(i, "I")
  103.         
  104.         
  105.     Next
  106.         ave = sum / Range("f2").CurrentRegion.Rows.Count
  107.    
  108.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  109.     If Cells(i, "I") < ave Then
  110.             
  111.             j = j + 1
  112.             
  113.         End If
  114.     Next
  115.         
  116.     MsgBox "有" & j & "人在平均工资以下"
  117. End Sub
  118. Sub 作业2_4高于10000的人()
  119.     Dim i As Long, j As Long, rng As Range
  120.         j = 1
  121.         For i = 2 To Range("f2").CurrentRegion.Rows.Count
  122.             If Cells(i, "I") > 10000 Then
  123.                 Set rng = Range("F" & i, "I" & i)
  124.                 rng.Select
  125.                 Selection.Copy
  126.                 Cells(j, "P").Select
  127.                 ActiveSheet.Paste
  128.                                 
  129.                 j = j + 1
  130.             End If
  131.         Next
  132.         
  133.         
  134. End Sub
  135. Sub 作业3优秀学生()
  136.     Dim i As Long, j As Long, 七十以上 As Long, 都七十 As Boolean
  137.     Dim 六十以上 As Long, 都及格 As Boolean, sum As Long, ave As Double, 都七五 As Boolean
  138.     Dim 优秀人数 As Long, k As Long
  139.    
  140.     优秀人数 = 0
  141.     k = 3
  142.    
  143.    
  144.     For i = 2 To Range("b2").CurrentRegion.Rows.Count
  145.         sum = 0
  146.         七十以上 = 0
  147.         六十以上 = 0
  148.         
  149.         For j = 2 To 8
  150.         If Cells(i, j) >= 70 Then
  151.             七十以上 = 七十以上 + 1
  152.         End If
  153.         Next
  154.         If 七十以上 = 7 Then
  155.             都七十 = True
  156.         Else
  157.             都七十 = False '每门课都在70以上,true
  158.         End If
  159.         For j = 2 To 8
  160.         If Cells(i, j) > 60 Then
  161.             六十以上 = 六十以上 + 1
  162.         End If
  163.         Next
  164.         If 六十以上 = 7 Then
  165.             都及格 = True
  166.         Else
  167.             都及格 = False '每门课都在60以上,true
  168.         End If
  169.         For j = 2 To 8
  170.             sum = sum + Cells(i, j)
  171.         Next
  172.         ave = sum / 7
  173.         If ave >= 75 Then
  174.             都七五 = True
  175.         Else
  176.             都七五 = False '每门课都在75以上,true
  177.         End If
  178.     If 都七十 Or (都及格 And 都七五) = True Then
  179.         
  180.         优秀人数 = 优秀人数 + 1
  181.         Cells(k, "M") = Cells(i, "A")
  182.         k = k + 1
  183.         Cells(3, "L") = 优秀人数
  184.     End If
  185.         
  186.     Next
  187.    
  188.         
  189. End Sub
  190. Sub 周末作业无序合并单元格()
  191.     Dim i As Long, j As Long
  192.     j = 1
  193.     For i = 2 To Range("b2").CurrentRegion.Rows.Count
  194.         If Range("a" & i) <> "" Then
  195.             j = j + 1
  196.             Range("f" & j) = Range("a" & i)
  197.             Range("g" & j) = Range("b" & i)
  198.         Else
  199.             Range("g" & j) = Range("g" & j) + Range("b" & i)
  200.                     
  201.         End If

  202.     Next
  203.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  204.         j = i + 1
  205.         
  206.         Do While j <= Range("f2").CurrentRegion.Rows.Count
  207.             If Cells(i, "f") = Cells(j, "f") Then
  208.                 Cells(i, "g") = Cells(i, "g") + Cells(j, "g")
  209.                 Range("f" & j, "g" & j).Delete xlShiftUp
  210.                 j = j + 1
  211.             Else
  212.                 j = j + 1
  213.             End If
  214.         Loop
  215.     Next
  216. End Sub

  217. Sub 周末作业选科非选科()
  218.     Dim i As Long
  219.     For i = 2 To Range("a2").CurrentRegion.Rows.Count
  220.         If Cells(i, "a") = "2" Or Cells(i, "a") = "3" Or _
  221.         Cells(i, "a") = "5" Or Cells(i, "a") = "6" Then
  222.             If Cells(i, "c") >= 85 Then
  223.                 Cells(i, "d") = "优秀化学"
  224.             ElseIf Cells(i, "c") >= 70 Then
  225.                 Cells(i, "d") = "合格化学"
  226.             Else
  227.                 Cells(i, "d") = "不合格化学"
  228.             End If
  229.             If Cells(i, "e") >= 80 Then
  230.                 Cells(i, "f") = "优秀"
  231.             ElseIf Cells(i, "e") >= 60 Then
  232.                 Cells(i, "f") = "合格"
  233.             Else
  234.                 Cells(i, "f") = "不及格"
  235.             End If
  236.              If Cells(i, "g") >= 80 Then
  237.                 Cells(i, "h") = "优秀"
  238.             ElseIf Cells(i, "g") >= 60 Then
  239.                 Cells(i, "h") = "合格"
  240.             Else
  241.                 Cells(i, "h") = "不及格"
  242.             End If
  243.         Else
  244.             If Cells(i, "c") >= 80 Then
  245.                 Cells(i, "d") = "优秀"
  246.             ElseIf Cells(i, "c") >= 60 Then
  247.                 Cells(i, "d") = "合格"
  248.             Else
  249.                 Cells(i, "d") = "不及格"
  250.             End If
  251.             If Cells(i, "e") >= 80 Then
  252.                 Cells(i, "f") = "优秀"
  253.             ElseIf Cells(i, "e") >= 60 Then
  254.                 Cells(i, "f") = "合格"
  255.             Else
  256.                 Cells(i, "f") = "不及格"
  257.             End If
  258.             If Cells(i, "g") >= 80 Then
  259.                 Cells(i, "h") = "优秀"
  260.             ElseIf Cells(i, "g") >= 60 Then
  261.                 Cells(i, "h") = "合格"
  262.             Else
  263.                 Cells(i, "h") = "不及格"
  264.             End If
  265.         End If
  266.     Next
  267. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-4-2 23:02:01 | 显示全部楼层

  1. Sub 重做吃太饱作业3循环()
  2.     Dim i As Long, 利润 As Double, 提成 As Double, 未提成 As Double
  3.    
  4.     For i = 2 To Range("a2").CurrentRegion.Rows.Count
  5.     利润 = Cells(i, 2)
  6.     未提成 = 利润
  7.     提成 = 0
  8.       
  9.     Do While 未提成 > 0
  10.         Select Case 未提成
  11.         Case Is > 100
  12.             提成 = 提成 + (未提成 - 100) * 0.8
  13.             未提成 = 100
  14.         Case Is > 60
  15.             提成 = 提成 + (未提成 - 60) * 0.5
  16.             未提成 = 60
  17.         Case Is > 40
  18.             提成 = 提成 + (未提成 - 40) * 0.3
  19.             未提成 = 40
  20.          Case Is > 20
  21.             提成 = 提成 + (未提成 - 20) * 0.2
  22.             未提成 = 20
  23.         Case Is > 10
  24.             提成 = 提成 + (未提成 - 10) * 0.1
  25.             未提成 = 10
  26.         Case Else
  27.             提成 = 提成 + 未提成 * 0.05
  28.             未提成 = 0
  29.         
  30.         End Select
  31.     Loop
  32.     Cells(i, 3) = 提成 * 10000
  33.    
  34.     Next
  35. End Sub
  36. Sub 作业1offsetresize练习作业1()
  37.     Dim rng1 As Range, rng2 As Range
  38.    
  39.     Set rng1 = Range("a1:h1")
  40.     Set rng2 = rng1.Offset(5, 0).Resize(7, 8)
  41.     rng1.Select
  42.     Selection.Copy
  43.     rng2.Select
  44.     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  45.    

  46. End Sub

  47. Sub 作业1offsetresize练习作业2()
  48.     Dim rng1 As Range, rng2 As Range
  49.    
  50.     Set rng1 = Cells(3, "K").Offset(5, -8)
  51.     rng1.Select
  52.     Set rng2 = rng1.Resize(4, 5)
  53.    
  54.     Cells(3, "K").Select
  55.     Selection.Copy
  56.     rng2.Select
  57.     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  58.    

  59. End Sub
  60. Sub 作业1offsetresize练习作业3()
  61.   
  62.      Range("a5").CurrentRegion.Replace 100, "满分"

  63. End Sub

  64. Sub 作业2_1生产部门男工资最低的人是谁()
  65.     Dim i As Long, 工资 As Long, 最低工资 As Long, 最低工资的人 As String
  66.    
  67.    
  68.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  69.         If Cells(i, "H") = "男" And Cells(i, "G") = "生产" Then
  70.             工资 = Cells(i, "I")
  71.             If 工资 < 最低工资 Then
  72.                 最低工资 = 工资
  73.             Else
  74.                 最低工资 = 最低工资
  75.                 最低工资的人 = Cells(i, "F")
  76.             End If
  77.         End If
  78.         
  79.         
  80.     Next
  81.     MsgBox "最低工资的人是" & 最低工资的人
  82. End Sub
  83. Sub 作业2_2张三达的工资排在所有人工资的第几名()
  84.     Dim i As Long, j As Long, 工资 As Long
  85.         工资 = Cells(2, "I")
  86.         j = 1
  87.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  88.         If Cells(i, "I") > 工资 Then
  89.             
  90.             j = j + 1
  91.             
  92.         End If
  93.         
  94.         
  95.     Next
  96.     MsgBox "张三达的工资排在所有人工资的第" & j & "名"
  97. End Sub

  98. Sub 作业2_3有多少人在平均工资以下()
  99.     Dim i As Long, sum As Long, j As Long, ave As Double
  100.         
  101.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  102.         sum = sum + Cells(i, "I")
  103.         
  104.         
  105.     Next
  106.         ave = sum / Range("f2").CurrentRegion.Rows.Count
  107.    
  108.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  109.     If Cells(i, "I") < ave Then
  110.             
  111.             j = j + 1
  112.             
  113.         End If
  114.     Next
  115.         
  116.     MsgBox "有" & j & "人在平均工资以下"
  117. End Sub
  118. Sub 作业2_4高于10000的人()
  119.     Dim i As Long, j As Long, rng As Range
  120.         j = 1
  121.         For i = 2 To Range("f2").CurrentRegion.Rows.Count
  122.             If Cells(i, "I") > 10000 Then
  123.                 Set rng = Range("F" & i, "I" & i)
  124.                 rng.Select
  125.                 Selection.Copy
  126.                 Cells(j, "P").Select
  127.                 ActiveSheet.Paste
  128.                                 
  129.                 j = j + 1
  130.             End If
  131.         Next
  132.         
  133.         
  134. End Sub
  135. Sub 作业3优秀学生()
  136.     Dim i As Long, j As Long, 七十以上 As Long, 都七十 As Boolean
  137.     Dim 六十以上 As Long, 都及格 As Boolean, sum As Long, ave As Double, 都七五 As Boolean
  138.     Dim 优秀人数 As Long, k As Long
  139.    
  140.     优秀人数 = 0
  141.     k = 3
  142.    
  143.    
  144.     For i = 2 To Range("b2").CurrentRegion.Rows.Count
  145.         sum = 0
  146.         七十以上 = 0
  147.         六十以上 = 0
  148.         
  149.         For j = 2 To 8
  150.         If Cells(i, j) >= 70 Then
  151.             七十以上 = 七十以上 + 1
  152.         End If
  153.         Next
  154.         If 七十以上 = 7 Then
  155.             都七十 = True
  156.         Else
  157.             都七十 = False '每门课都在70以上,true
  158.         End If
  159.         For j = 2 To 8
  160.         If Cells(i, j) > 60 Then
  161.             六十以上 = 六十以上 + 1
  162.         End If
  163.         Next
  164.         If 六十以上 = 7 Then
  165.             都及格 = True
  166.         Else
  167.             都及格 = False '每门课都在60以上,true
  168.         End If
  169.         For j = 2 To 8
  170.             sum = sum + Cells(i, j)
  171.         Next
  172.         ave = sum / 7
  173.         If ave >= 75 Then
  174.             都七五 = True
  175.         Else
  176.             都七五 = False '每门课都在75以上,true
  177.         End If
  178.     If 都七十 Or (都及格 And 都七五) = True Then
  179.         
  180.         优秀人数 = 优秀人数 + 1
  181.         Cells(k, "M") = Cells(i, "A")
  182.         k = k + 1
  183.         Cells(3, "L") = 优秀人数
  184.     End If
  185.         
  186.     Next
  187.    
  188.         
  189. End Sub
  190. Sub 周末作业无序合并单元格()
  191.     Dim i As Long, j As Long
  192.     j = 1
  193.     For i = 2 To Range("b2").CurrentRegion.Rows.Count
  194.         If Range("a" & i) <> "" Then
  195.             j = j + 1
  196.             Range("f" & j) = Range("a" & i)
  197.             Range("g" & j) = Range("b" & i)
  198.         Else
  199.             Range("g" & j) = Range("g" & j) + Range("b" & i)
  200.                     
  201.         End If

  202.     Next
  203.     For i = 2 To Range("f2").CurrentRegion.Rows.Count
  204.         j = i + 1
  205.         
  206.         Do While j <= Range("f2").CurrentRegion.Rows.Count
  207.             If Cells(i, "f") = Cells(j, "f") Then
  208.                 Cells(i, "g") = Cells(i, "g") + Cells(j, "g")
  209.                 Range("f" & j, "g" & j).Delete xlShiftUp
  210.                 j = j + 1
  211.             Else
  212.                 j = j + 1
  213.             End If
  214.         Loop
  215.     Next
  216. End Sub

  217. Sub 周末作业选科非选科()
  218.     Dim i As Long
  219.     For i = 2 To Range("a2").CurrentRegion.Rows.Count
  220.         If Cells(i, "a") = "2" Or Cells(i, "a") = "3" Or _
  221.         Cells(i, "a") = "5" Or Cells(i, "a") = "6" Then
  222.             If Cells(i, "c") >= 85 Then
  223.                 Cells(i, "d") = "优秀化学"
  224.             ElseIf Cells(i, "c") >= 70 Then
  225.                 Cells(i, "d") = "合格化学"
  226.             Else
  227.                 Cells(i, "d") = "不合格化学"
  228.             End If
  229.             If Cells(i, "e") >= 80 Then
  230.                 Cells(i, "f") = "优秀"
  231.             ElseIf Cells(i, "e") >= 60 Then
  232.                 Cells(i, "f") = "合格"
  233.             Else
  234.                 Cells(i, "f") = "不及格"
  235.             End If
  236.              If Cells(i, "g") >= 80 Then
  237.                 Cells(i, "h") = "优秀"
  238.             ElseIf Cells(i, "g") >= 60 Then
  239.                 Cells(i, "h") = "合格"
  240.             Else
  241.                 Cells(i, "h") = "不及格"
  242.             End If
  243.         Else
  244.             If Cells(i, "c") >= 80 Then
  245.                 Cells(i, "d") = "优秀"
  246.             ElseIf Cells(i, "c") >= 60 Then
  247.                 Cells(i, "d") = "合格"
  248.             Else
  249.                 Cells(i, "d") = "不及格"
  250.             End If
  251.             If Cells(i, "e") >= 80 Then
  252.                 Cells(i, "f") = "优秀"
  253.             ElseIf Cells(i, "e") >= 60 Then
  254.                 Cells(i, "f") = "合格"
  255.             Else
  256.                 Cells(i, "f") = "不及格"
  257.             End If
  258.             If Cells(i, "g") >= 80 Then
  259.                 Cells(i, "h") = "优秀"
  260.             ElseIf Cells(i, "g") >= 60 Then
  261.                 Cells(i, "h") = "合格"
  262.             Else
  263.                 Cells(i, "h") = "不及格"
  264.             End If
  265.         End If
  266.     Next
  267. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-4-4 23:27:31 | 显示全部楼层

  1. '第9课 题一 01:背景为黄色的区域用Range("A1:H1")的Offset属性和Resize属性来表示 :
  2. 'range("a1:h1").offset(5,0).resize(7,8)

  3. '第9课 题一 02:字体为红色的区域用Cells(3,"K")的Offset属性和Resize属性来表示 :
  4. 'Cells(3,"K").Offset(5,-8).resize(4,5).address(0,0)

  5. '第9课  题二:从A5出发将上表中的所有100分改为"满分"  :
  6. 'Cells(5,1).Offset(1,3).resize(7,5).replace 100 , "满分"





  7. Sub 第9课作业2点1生产部门男性工资最低的人是谁()
  8. Dim i As Long, 总工资 As Double, 平均工资 As Double
  9. Dim 男工资 As Double, 低薪男 As String
  10. For i = 2 To Range("f1").CurrentRegion.Rows.Count
  11.     总工资 = 总工资 + Cells(i, "i")
  12.     平均工资 = 总工资 / (i - 1)
  13. Next i

  14.      男工资 = 总工资
  15. For i = 2 To Range("f1").CurrentRegion.Rows.Count
  16.     If Cells(i, "h") = "男" Then
  17.         If 男工资 > Cells(i, "i") Then
  18.             男工资 = Cells(i, "i")
  19.             低薪男 = Cells(i, "i").Offset(0, -3)
  20.         Else
  21.         End If
  22.     End If
  23. Next i
  24. MsgBox "生产部门男性工资最低的人是:    " & 低薪男
  25. End Sub

  26. Sub 第9课作业2点2张三达的工资排在所有人工资的第几名()
  27. Dim i As Long, 张三达工资 As Double, 名次
  28. For i = 2 To Cells(1, 5).CurrentRegion.Rows.Count
  29.     If Cells(i, 6) = "张三达" Then 张三达工资 = Cells(i, 6).Offset(0, 3)
  30. Next i
  31. 名次 = 1
  32. For i = 2 To Cells(1, 5).CurrentRegion.Rows.Count
  33.     If 张三达工资 < Cells(i, 9) Then 名次 = 名次 + 1
  34. Next i
  35. MsgBox "张三达的工资排在所有人工资的第  " & 名次 & "  名"
  36. End Sub

  37. Sub 第9课作业2点3有多少人在平均工资以下()
  38. Dim i As Long, 总工资 As Double, 平均工资 As Double
  39. Dim 均值下人数 As Long
  40. For i = 2 To Range("f1").CurrentRegion.Rows.Count
  41.     总工资 = 总工资 + Cells(i, "i")
  42.     平均工资 = 总工资 / (i - 1)
  43. Next i
  44. For i = 2 To Range("f1").CurrentRegion.Rows.Count
  45.     If Range("i" & i) < 平均工资 Then 均值下人数 = 均值下人数 + 1
  46. Next i
  47. MsgBox "在平均工资以下  " & 均值下人数 & "  名"
  48. End Sub

  49. Sub 第9课作业2点4()
  50. Dim i As Long, 新行 As Long
  51. 新行 = 1
  52. For i = 2 To Range("f1").CurrentRegion.Rows.Count
  53.     If Range("i" & i) > 10000 Then
  54.         新行 = 新行 + 1
  55.         Dim i内 As Long, 原列 As Long, 目标列 As Long
  56.         原列 = 9: 目标列 = 19
  57.         For i内 = 0 To 3
  58.             Cells(新行, 目标列).Offset(0, -i内) = Cells(i, 原列).Offset(0, -i内)
  59.         Next i内
  60.     Else
  61.     End If
  62. Next i
  63. End Sub



  64. Sub 第9课作业3优秀学生人数与名单()
  65. Dim i As Long, j As Long, 计数 As Long
  66. Dim 七十 As Long, 不及格 As Long
  67. Dim 成绩 As Double, 总成绩 As Double
  68. 计数 = 2
  69. For i = 2 To Cells(1, 1).CurrentRegion.Rows.Count
  70.     For j = 2 To Cells(1, 1).CurrentRegion.Columns.Count
  71.         成绩 = Cells(i, j)
  72.         Select Case 成绩
  73.         Case Is >= 70
  74.             七十 = 七十 + 1
  75.         Case Is < 60
  76.             不及格 = 不及格 + 1
  77.         End Select
  78.         总成绩 = 总成绩 + Cells(i, j)
  79.     Next j
  80.    
  81.     If (七十 = j - 2) Or (总成绩 / (j - 2) >= 75 And 不及格 = 0) Then
  82.     计数 = 计数 + 1
  83.     Cells(计数, 13) = Cells(i, 1)
  84.     Else
  85.     End If
  86.     Range("l3") = 计数 - 2
  87.     七十 = 0
  88.     不及格 = 0
  89.     总成绩 = 0
  90. Next i
  91. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-4-7 21:01:07 | 显示全部楼层
  1. Sub 作业032301()
  2.     Range("a1:h1").Offset(5, 0).Resize _
  3.     (Range("a1:h1").CurrentRegion.Rows.Count + 6, _
  4.     Range("a1:h1").CurrentRegion.Columns.Count + 7).Select
  5.    

  6. End Sub
  7.   
  8. Sub 作业032302()
  9.     Cells(3, "k").Offset(5, -8).Resize _
  10.     (Cells(3, "k").CurrentRegion.Rows.Count + 3, _
  11.      Cells(3, "k").CurrentRegion.Columns.Count + 4).Select

  12. End Sub


  13.   Sub 作业032303()
  14.     Cells(5, "a").Offset(1, 3).Resize _
  15.     (Cells(5, "a").CurrentRegion.Rows.Count - 3, _
  16.      Cells(5, "a").CurrentRegion.Columns.Count - 3).Select
  17.        Cells(5, "a").CurrentRegion.Replace 100, "满分"

  18.   End Sub
  19.     Sub 作业()
  20.       Dim 最低工资 As Long, x As Long, 姓名 As String
  21.       For x = 2 To Range("f1").CurrentRegion.Rows.Count
  22.          最低工资 = Cells(2, "i")
  23.          If Cells(x, "g") = "生产" And Cells(x, "h") = "男" And Cells(x, "i") < 最低工资 Then
  24.          
  25.                最低工资 = Cells(x, "i")
  26.                姓名 = Cells(x, "i").Offset(0, -3)
  27.     ElseIf Cells(x, "g") = "生产" And Cells(x, "h") = "男" And Cells(x, "i") = 最低工资 Then
  28.                
  29.                     姓名 = Cells(2, "f")
  30.     End If
  31.             
  32.     Next
  33.                MsgBox "生产部门男性工资最低的人是: " & 姓名
  34.    
  35.     End Sub
  36.   Sub 排名()
  37.      Dim x As Long, y As Long
  38.     For x = 2 To Range("f1").CurrentRegion.Rows.Count
  39.    
  40.      If Cells(2, "i") <= Cells(x, "i") Then
  41.      y = y + 1
  42.         
  43.      End If
  44.      
  45.         Next
  46.                     MsgBox "张三达的工资排在所有人工资的第" & y & "名"
  47. End Sub

  48. Sub 平均工资人数()
  49.     Dim 平均工资 As Double, x As Long, y As Long, sum As Double
  50.    
  51.     For x = 2 To Range("f1").CurrentRegion.Rows.Count
  52.       
  53.         sum = sum + Cells(x, "i")
  54.   Next
  55.          平均工资 = sum / (Range("f1").CurrentRegion.Rows.Count - 1)
  56. For x = 2 To Range("f1").CurrentRegion.Rows.Count
  57.       If Cells(x, "i") < 平均工资 Then
  58.       y = y + 1
  59.    End If
  60.    Next
  61.             MsgBox "有" & y & "人在平均工资以下"

  62. End Sub

  63. Sub 优秀学生()
  64.       Dim sum As Double, x As Long, y As Long, 姓名 As String, 科目数1 As Long, 科目数2 As Long
  65.       Dim 优秀学生人数 As Long
  66.       优秀学生人数 = 0
  67.       For x = 2 To Range("a1").CurrentRegion.Rows.Count
  68.              科目数1 = 0
  69.              科目数2 = 0
  70.              sum = 0
  71.        For y = 2 To Range("a1").CurrentRegion.Columns.Count
  72.       
  73.            If Cells(x, y) >= 70 Then 科目数1 = 科目数1 + 1
  74.            If Cells(x, y) < 60 Then 科目数2 = 科目数2 + 1
  75.              sum = sum + Cells(x, y)
  76.             
  77.   Next
  78.           If 科目数1 = 7 Or (科目数2 = 0 And sum / 7 >= 75) Then
  79.             优秀学生人数 = 优秀学生人数 + 1
  80.            Cells(3, "l") = 优秀学生人数
  81.            Cells(2 + 优秀学生人数, "m") = Cells(x, 1)
  82.             End If
  83.            Next
  84. End Sub
  85. Sub 计算选科()
  86.     Dim x As Long, y As Long, 成绩 As Double
  87.     For x = 2 To Range("a1").CurrentRegion.Rows.Count
  88.     For y = 3 To Range("a1").CurrentRegion.Columns.Count - 1 Step 2
  89.         
  90.             If Cells(1, y) = "化学" Then
  91.             If Cells(x, 1) = 2 Or Cells(x, 1) = 3 Or Cells(x, 1) = 5 Or Cells(x, 1) = 6 Then
  92.                        
  93.                      Select Case Cells(x, y)
  94.                    Case Is >= 85
  95.                        Cells(x, y + 1) = "优秀"
  96.                    Case Is >= 70
  97.                        Cells(x, y + 1) = "合格"
  98.                    Case Is < 70
  99.                        Cells(x, y + 1) = "不合格"
  100.                  End Select
  101.                  
  102.       Else
  103.                  Select Case Cells(x, y)
  104.                    Case Is >= 80
  105.                        Cells(x, y + 1) = "优秀"
  106.                    Case Is >= 60
  107.                        Cells(x, y + 1) = "合格"
  108.                    Case Is < 60
  109.                        Cells(x, y + 1) = "不合格"
  110.                  End Select
  111.               End If
  112.          
  113.       Else
  114.                  Select Case Cells(x, y)
  115.                    Case Is >= 80
  116.                        Cells(x, y + 1) = "优秀"
  117.                    Case Is >= 60
  118.                        Cells(x, y + 1) = "合格"
  119.                    Case Is < 60
  120.                        Cells(x, y + 1) = "不合格"
  121.                  End Select
  122.                  End If
  123. Next
  124. Next


  125. End Sub

  126. Sub 合拼()
  127.        Dim x As Long, y As Long, o As Long, p As Long, area As Range
  128.         y = 1
  129.        For x = 2 To Range("a1").CurrentRegion.Rows.Count
  130.        If Cells(x, "a") <> "" Then
  131.        y = y + 1
  132.        Cells(y, "f") = Cells(x, "a")
  133.        Cells(y, "g") = Cells(x, "b")
  134.    Else
  135.        Cells(y, "g") = Cells(y, "g") + Cells(x, "b")
  136.       
  137.        End If
  138.       
  139.        Next
  140.        Set area = Range("f1").CurrentRegion
  141.        For o = 2 To area.Rows.Count
  142.        p = o + 1
  143.        Do While p <= area.Rows.Count
  144.              If Cells(o, "f") = Cells(p, "f") Then
  145.              Cells(o, "g") = Cells(o, "g") + Cells(p, "g")
  146.               area.Rows(p).Delete xlShiftUp
  147.          Else
  148.             p = p + 1
  149.             End If
  150.             Loop
  151.             Next
  152.             
  153. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-4-8 21:57:27 | 显示全部楼层
  1. Sub 作业1()

  2.     Range("a1:h1").Offset(5, 0).Resize(7, 8).Select
  3.     Cells(3, "K").Offset(5, -8).Resize(4, 5).Select
  4.     Cells(5, "A").Offset(1, 0).Resize(7, 8).Replace 100, "满分"

  5. End Sub

  6. Sub 男性工资最低()
  7.     Dim 工资最低 As String, 工资 As Double, 最小工资 As Double, i As Long
  8.     最小工资 = Cells(2, "I")
  9.         For i = 2 To Range("I2").CurrentRegion.Rows.Count
  10.             工资 = Cells(i, "I")
  11.                 If 工资 < 最小工资 And Cells(i, "H") = "男" Then
  12.                     最小工资 = 工资
  13.                     工资最低 = Cells(i, "F")
  14.                 End If
  15.         Next
  16.     MsgBox ("生产部门男性工资最低的人是 " & 工资最低)

  17. End Sub

  18. Sub 张三达工资排名()
  19.     Dim a As Long, i As Long, 排名 As Long
  20.     排名 = 1
  21.     a = Range("f1").CurrentRegion.Find("张三达").Row
  22.     For i = 2 To Range("f1").CurrentRegion.Rows.Count
  23.         If Cells(i, "I") > Cells(a, "I") Then
  24.             排名 = 排名 + 1
  25.         End If
  26.     Next
  27.     MsgBox ("张三达的工资排在所有人工资的第 " & 排名 & " 名")

  28. End Sub

  29. Sub 平均工资()
  30.     Dim 平均工资 As Double, i As Long, a As Long
  31.     平均工资 = WorksheetFunction.Average(Range("I:I"))
  32.         For i = 2 To Range("f1").CurrentRegion.Rows.Count
  33.             If Cells(i, "I") > 平均工资 Then
  34.                 a = a + 1
  35.             End If
  36.     Next
  37.     MsgBox ("有 " & a & " 人在平均工资以下")

  38. End Sub

  39. Sub 工资大于10000()
  40. ActiveSheet.ListObjects("Table1454").Range.AutoFilter Field:=4, Criteria1:= _
  41.         ">10000", Operator:=xlAnd
  42.     Range("Table1454[#All]").Select
  43.     Selection.Copy
  44.     Range("P1").Select
  45.     ActiveSheet.Paste
  46.     Application.CutCopyMode = False
  47.     Range("J1").Select
  48.     ActiveSheet.ListObjects("Table1454").Range.AutoFilter Field:=4

  49. End Sub

  50. Sub 优秀学生()
  51.     Dim i As Long, j As Long, 大于70分 As Long, 不及格 As Long, 优秀学生 As Long, a As Long
  52.     Range("L3:M100").ClearContents
  53.         For i = 2 To Range("a1").CurrentRegion.Rows.Count
  54.             For j = 2 To Range("a1").CurrentRegion.Columns.Count
  55.                 If Cells(i, j) >= 70 Then
  56.                     大于70分 = 大于70分 + 1
  57.                 ElseIf Cells(i, j) < 60 Then
  58.                     不及格 = 不及格 + 1
  59.                 End If
  60.             Next
  61.             If 大于70分 = Range("a1").CurrentRegion.Columns.Count - 1 Or WorksheetFunction.Average(Cells(i, 1).EntireRow) >= 75 And 不及格 = 0 Then
  62.                 优秀学生 = 优秀学生 + 1
  63.                 a = Cells(Rows.Count, "M").End(xlUp).Row + 1
  64.                 Cells(a, "M") = Cells(i, 1)
  65.             End If
  66.             大于70分 = 0
  67.             不及格 = 0
  68.         Next
  69.     Cells(3, "L") = 优秀学生
  70. End Sub
复制代码
回复 支持 反对

使用道具 举报

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

本版积分规则

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