白话Excel函数公式 Office易学宝微视频教程合集(Excel+Word+PPT)
笨办法学VBA(从入门到精通) 高效办公必会的Office实战技巧
财务总监的Excel私房课 网易云课堂-Excel数据透视表应用大全
Excel图表神技
查看: 486|回复: 3

练习7

[复制链接]
发表于 2015-8-28 15:18:57 | 显示全部楼层 |阅读模式
本帖最后由 临时户口 于 2015-9-8 12:55 编辑

本题比较基础考验学生对循环,分支判断,多分支语句的基本掌握情况。
并且一并考察学员对于程序编写时细节的把握能力。


本题:
如果能够通过编码正确达成效果:奖励20dp(并且注重细节,如果没有注重细节,代码多次执行计算错误的,扣3dp)
代码相对简洁(不是指语句长度,而是没有冗余代码的)再增加奖励5 dp





本题感谢hehex(胡说老师)提供,本题截至2015-9-5

统计出现次数.zip

13.79 KB, 下载次数: 12

回复

使用道具 举报

发表于 2015-8-28 16:24:00 | 显示全部楼层
  1. Option Explicit

  2. Sub test()
  3.     Dim arr, i&, c1, c2
  4.     With Sheet1
  5.         arr = .Range("a1").CurrentRegion
  6.         ReDim c1(1 To 4)
  7.         ReDim c2(1 To 4)
  8.     For i = 1 To UBound(arr)
  9.         If arr(i, 1) = "A1" Then
  10.             If Abs(arr(i, 2)) >= 1 And Abs(arr(i, 2)) <= 10 Then
  11.                 c1(1) = c1(1) + 1
  12.             ElseIf Abs(arr(i, 2)) >= 11 And Abs(arr(i, 2)) <= 100 Then
  13.                 c1(2) = c1(2) + 1
  14.             ElseIf Abs(arr(i, 2)) >= 101 And Abs(arr(i, 2)) <= 500 Then
  15.                 c1(3) = c1(3) + 1
  16.             ElseIf Abs(arr(i, 2)) >= 501 And Abs(arr(i, 2)) <= 1000 Then
  17.                 c1(4) = c1(4) + 1
  18.             End If
  19.         ElseIf arr(i, 1) = "A2" Then
  20.              If Abs(arr(i, 2)) >= 1 And Abs(arr(i, 2)) <= 10 Then
  21.                 c2(1) = c2(1) + 1
  22.             ElseIf Abs(arr(i, 2)) >= 11 And Abs(arr(i, 2)) <= 100 Then
  23.                 c2(2) = c2(2) + 1
  24.             ElseIf Abs(arr(i, 2)) >= 101 And Abs(arr(i, 2)) <= 500 Then
  25.                 c2(3) = c2(3) + 1
  26.             ElseIf Abs(arr(i, 2)) >= 501 And Abs(arr(i, 2)) <= 1000 Then
  27.                 c2(4) = c2(4) + 1
  28.             End If
  29.         End If
  30.     Next
  31.     .Range("g2").Resize(2, 4) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Array(c1, c2)))
  32.     End With
  33. End Sub
复制代码

点评

一开始就可以定义个二维4列的数组 最后输出也无需二次转置  发表于 2015-9-8 12:53

评分

参与人数 1登攀 +20 收起 理由
临时户口 + 20

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2015-9-4 12:01:15 | 显示全部楼层
方法一:
  1. Sub 统计出现次数()
  2.     Dim i As Long, j As Long
  3.     Range("g2:j3").ClearContents
  4.     j = Range("a35565").End(xlUp).Row
  5.     For i = 1 To j
  6.         If Range("a" & i) = "A1" Then
  7.             Select Case Range("b" & i)
  8.                 Case -10 To -1, 1 To 10
  9.                     Range("g2") = Range("g2") + 1
  10.                 Case -100 To -11, 11 To 100
  11.                     Range("h2") = Range("h2") + 1
  12.                 Case -500 To -101, 101 To 500
  13.                     Range("i2") = Range("i2") + 1
  14.                 Case -1000 To -501, 501 To 1000
  15.                 Range("j2") = Range("j2") + 1
  16.             End Select
  17.         Else
  18.             Select Case Range("b" & i)
  19.                 Case -10 To -1, 1 To 10
  20.                     Range("g3") = Range("g3") + 1
  21.                 Case -100 To -11, 11 To 100
  22.                     Range("h3") = Range("h3") + 1
  23.                 Case -500 To -101, 101 To 500
  24.                     Range("i3") = Range("i3") + 1
  25.                 Case -1000 To -501, 501 To 1000
  26.                     Range("j3") = Range("j3") + 1
  27.             End Select
  28.         End If
  29.     Next
  30. End Sub
复制代码
方法二:
  1. Sub 出现次数()
  2.     Dim brr(1 To 2, 1 To 4)
  3.     arr = Range("a1").CurrentRegion
  4.     For i = 1 To UBound(arr)
  5.         If arr(i, 1) = "A1" Then
  6.             j = 1
  7.             Select Case arr(i, 2)
  8.                 Case -10 To -1, 1 To 10
  9.                     brr(j, 1) = brr(j, 1) + 1
  10.                 Case -100 To -11, 11 To 100
  11.                     brr(j, 2) = brr(j, 2) + 1
  12.                 Case -500 To -101, 101 To 500
  13.                     brr(j, 3) = brr(j, 3) + 1
  14.                 Case -1000 To -501, 501 To 1000
  15.                     brr(j, 4) = brr(j, 4) + 1
  16.             End Select
  17.         Else
  18.             j = 2
  19.             Select Case arr(i, 2)
  20.                 Case -10 To -1, 1 To 10
  21.                     brr(j, 1) = brr(j, 1) + 1
  22.                 Case -100 To -11, 11 To 100
  23.                     brr(j, 2) = brr(j, 2) + 1
  24.                 Case -500 To -101, 101 To 500
  25.                     brr(j, 3) = brr(j, 3) + 1
  26.                 Case -1000 To -501, 501 To 1000
  27.                     brr(j, 4) = brr(j, 4) + 1
  28.             End Select
  29.         End If
  30.     Next
  31.     Range("g2").Resize(2, 4) = brr
  32. End Sub
复制代码



评分

参与人数 1登攀 +25 收起 理由
临时户口 + 25

查看全部评分

回复 支持 反对

使用道具 举报

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

本版积分规则

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