6月5/6日 Excel函数实战技巧精粹 300集Office 2010微视频教程
5月7日 Excel VBA开发实战 高效办公必会的Office实战技巧
5月6日 Excel透视表实战秘技 网易云课堂-Excel数据透视表应用大全
Excel数据处理与分析实战技巧第1季
查看: 723|回复: 12

零基础12期-第十四课作业

[复制链接]
发表于 2018-1-1 14:45:03 | 显示全部楼层 |阅读模式
本帖最后由 开心妙妙 于 2018-1-16 14:51 编辑

交作业之前先看群文件作业提交说明
回复

使用道具 举报

发表于 2018-1-1 14:48:00 | 显示全部楼层
  1. '花开菊白贵争妍,好景宜人留晚天,霞落潭中波漾影,纱笼树色月笼烟.
  2. '倒转字符串
  3. Function reverse(str As String)
  4.     Dim s As String, i As Long
  5.     If Len(str) = 1 Then
  6.         reverse = str
  7.     Else
  8.         reverse = Right(str, 1) & reverse(Left(str, Len(str) - 1))
  9.     End If
  10. End Function
  11. '奇数多保留奇数,偶数多保留偶数,结果用分号连接。
  12. Function modstr(area As Range)
  13.     Dim i As Range, odd&, even&, Ostr, Estr As String
  14.     For Each i In area
  15.         If i Mod 2 = 1 Then
  16.             odd = odd + 1
  17.             Ostr = Ostr & ";" & i
  18.         Else
  19.             even = even + 1
  20.             Estr = Estr & ";" & i
  21.         End If
  22.     Next
  23.     If Len(Ostr) > Len(Estr) Then
  24.         modstr = Right(Ostr, Len(Ostr) - 1)
  25.     Else
  26.         modstr = Right(Estr, Len(Estr) - 1)
  27.     End If
  28. End Function
  29. '聚光灯,十字变黄聚光灯.
  30. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  31.     Dim area As Range, rng As Range
  32.     Cells.Interior.Color = xlNone
  33.     Set area = [A1].CurrentRegion
  34.     Set rng = Application.Intersect(area, Target)
  35.     If Not rng Is Nothing Then
  36.         Application.Intersect(Rows(Target.Row), area).Interior.Color = vbYellow
  37.         Application.Intersect(Columns(Target.Column), area).Interior.Color = vbYellow
  38.     Else
  39.         MsgBox "不在区域内"
  40.     End If
  41. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-1 16:20:34 | 显示全部楼层
  1. Function g(b)'作业1
  2. Dim i, j%, k%, l, m, f, n%
  3. For Each i In b
  4.     If i = "" Then
  5.     n = n + 1
  6.     ElseIf i Mod 2 = 0 Then
  7.     j = j + 1
  8.     l = l & i & ";"
  9.     ElseIf i Mod 2 = 1 Then
  10.     k = k + 1
  11.     m = m & i & ";"
  12.     End If
  13. Next
  14. If n > 0 Then
  15. g = ""
  16. ElseIf j > k Then
  17. f = l
  18. g = Left(f, Len(f) - 1)
  19. ElseIf j < k Then
  20. f = m
  21. g = Left(f, Len(f) - 1)
  22. End If
  23. End Function
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-1 16:50:08 | 显示全部楼层
  1. '花开菊白贵争妍,好景宜人留晚天,霞落潭中波漾影,纱笼树色月笼烟.
  2. '倒转字符串
  3. Function reverse(str As String)
  4.     Dim s As String, i As Long
  5.     If Len(str) = 1 Then
  6.         reverse = str
  7.     Else
  8.         reverse = Right(str, 1) & reverse(Left(str, Len(str) - 1))
  9.     End If
  10. End Function
  11. '奇数多保留奇数,偶数多保留偶数,结果用分号连接。
  12. Function modstr(area As Range)
  13.     Dim i As Range, odd&, even&, Ostr, Estr As String
  14.     For Each i In area
  15.         If i Mod 2 = 1 Then
  16.             odd = odd + 1
  17.             Ostr = Ostr & ";" & i
  18.         Else
  19.             even = even + 1
  20.             Estr = Estr & ";" & i
  21.         End If
  22.     Next
  23.     If Len(Ostr) > Len(Estr) Then
  24.         modstr = Right(Ostr, Len(Ostr) - 1)
  25.     Else
  26.         modstr = Right(Estr, Len(Estr) - 1)
  27.     End If
  28. End Function
  29. '聚光灯,十字变黄聚光灯.
  30. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  31.     Dim area As Range, rng As Range
  32.     Cells.Interior.Color = xlNone
  33.     Set area = [A1].CurrentRegion
  34.     Set rng = Application.Intersect(area, Target)
  35.     If Not rng Is Nothing Then
  36.         Application.Intersect(Rows(Target.Row), area).Interior.Color = vbYellow
  37.         Application.Intersect(Columns(Target.Column), area).Interior.Color = vbYellow
  38.     Else
  39.         MsgBox "不在区域内"
  40.     End If
  41. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-2 09:43:30 | 显示全部楼层
  1. '作业一题目要求:
  2. '1、A2:C18是0-9的随机数;
  3. '2、以是奇数或偶数为条件;
  4. '3、去除只出现1次的奇数或偶数;(即:奇数多保留奇数,偶数多保留偶数)
  5. '4、结果用分号连接
  6. Function modstr1(rng As Range)
  7.     Dim i As Long, j As Long, ran As Range, jiegou1 As String, jiegou2 As String
  8.     For Each ran In rng
  9.         If ran Mod 2 = 0 Then
  10.             i = i + 1
  11.             jiegou1 = jiegou1 & ";" & ran
  12.             
  13.         Else
  14.             j = j + 1
  15.             jiegou2 = jiegou2 & ";" & ran
  16.         End If
  17.     Next
  18.         If i > j Then
  19.             modstr1 = Right(jiegou1, Len(jiegou1) - 1)
  20.         Else
  21.             modstr1 = Right(jiegou2, Len(jiegou2) - 1)
  22.         End If
  23. End Function
  24. '作业二,聚光灯
  25. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  26.     Cells.Interior.Color = xlNone
  27.      If (Intersect(Target, [a1].CurrentRegion) Is Nothing) And Target.Count > 1 Then Exit Sub
  28.      Target.CurrentRegion.Rows(Target.Row).Interior.Color = vbYellow
  29.      Target.CurrentRegion.Columns(Target.Column).Interior.Color = vbYellow
  30.      
  31. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-3 13:47:28 | 显示全部楼层
  1. Function modstr(area As Range)
  2.     Dim rng As Range, i As Long, j As Long, str1 As String, str2 As String
  3.     For Each rng In area
  4.         If rng Mod 2 = 1 Then
  5.             i = i + 1
  6.             str1 = str1 & ";" & rng.Value
  7.         ElseIf rng Mod 2 = 0 Then
  8.             j = j + 1
  9.             str2 = str2 & ";" & rng.Value
  10.         End If
  11.     Next
  12.     If i > j Then
  13.         modstr = Right(str1, Len(str1) - 1)
  14.     ElseIf j > i Then
  15.         modstr = Right(str2, Len(str2) - 1)
  16.     End If
  17. End Function
  18. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  19.     Dim area As Range
  20.     Set area = Intersect(Target, Range("a1").CurrentRegion)
  21.     Cells.Interior.Color = xlNone
  22.     If Target.Count > 1 Then Exit Sub
  23.     If area Is Nothing Then Exit Sub
  24.     If area = Target Then
  25.         Intersect(Target.EntireRow, Range("a1").CurrentRegion).Interior.Color = vbYellow
  26.         Intersect(Target.EntireColumn, Range("a1").CurrentRegion).Interior.Color = vbYellow
  27.     End If
  28. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-3 14:07:29 | 显示全部楼层
  1. Function modstr(area As Range)
  2.     Dim rng As Range, i As Long, j As Long, str1 As String, str2 As String
  3.     For Each rng In area
  4.         If rng Mod 2 = 1 Then
  5.             i = i + 1
  6.             str1 = str1 & ";" & rng.Value
  7.         ElseIf rng Mod 2 = 0 Then
  8.             j = j + 1
  9.             str2 = str2 & ";" & rng.Value
  10.         End If
  11.     Next
  12.     If i > j Then
  13.         modstr = Right(str1, Len(str1) - 1)
  14.     ElseIf j > i Then
  15.         modstr = Right(str2, Len(str2) - 1)
  16.     End If
  17. End Function
  18. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  19.     Dim area As Range
  20.     Set area = Intersect(Target, Range("a1").CurrentRegion)
  21.     Cells.Interior.Color = xlNone
  22.     If Target.Count > 1 Then Exit Sub
  23.     If area Is Nothing Then Exit Sub
  24.     If area = Target Then
  25.         Intersect(Target.EntireRow, Range("a1").CurrentRegion).Interior.Color = vbYellow
  26.         Intersect(Target.EntireColumn, Range("a1").CurrentRegion).Interior.Color = vbYellow
  27.     End If
  28. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-4 15:33:15 | 显示全部楼层
奇数偶数
  1. Function modstr(rng As Range)
  2. Application.Volatile
  3. Dim area As Range
  4. Dim 偶 As String, 奇 As String
  5.     For Each area In rng
  6.    
  7.         If area = 0 Or area Mod 2 = 0 Then
  8.             偶 = 偶 & area & ";"
  9.         Else
  10.             奇 = 奇 & area & ";"
  11.         End If
  12.         
  13.         Next
  14.         
  15.         
  16.         If Len(偶) > Len(奇) Then
  17.             modstr = Left(偶, Len(偶) - 1)
  18.         Else
  19.             modstr = Left(奇, Len(奇) - 1)
  20.         End If
  21.             

  22. End Function
复制代码



聚光灯

  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim area As Range, rng As Range
  3.     Dim 行 As Range, 列 As Range
  4.     Set rng = Range("a1").CurrentRegion
  5.     Set area = Intersect(rng, Target)
  6.     Cells.Interior.Color = xlNone
  7.     If Not area Is Nothing Then
  8.         Set 行 = Range(Target.End(xlUp), Target.End(xlDown))
  9.         Set 列 = Range(Target.End(xlToLeft), Target.End(xlToRight))
  10.         行.Interior.ColorIndex = 4
  11.         列.Interior.ColorIndex = 4
  12.         
  13.     Else
  14.         Cells.Interior.Color = xlNone
  15.     End If

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

使用道具 举报

发表于 2018-1-4 16:10:54 | 显示全部楼层
‘我是民航骄子


递归作业
  1. Option Explicit

  2. Sub Reverse_Fabonacci()

  3.     Debug.Print Reverse("123456")
  4.     Debug.Print fabonacci(20)

  5. End Sub


  6. Function Reverse(rng As String)

  7.     'str 是字符串,n是字符串的长度,i用于循环
  8.     Dim str As String, n As Long, i As Long
  9.    
  10.     i = Len(rng)
  11.    
  12.     Select Case i
  13.     Case 1
  14.         Reverse = rng
  15.     Case 2
  16.         Reverse = Right(rng, 1) & Left(rng, 1)
  17.     Case Else
  18.         Reverse = Right(rng, 1) & Reverse(Mid(rng, 2, i - 2)) & Left(rng, 1)
  19.         
  20.         
  21.     End Select
  22.    
  23.    

  24. End Function



  25. Function fabonacci(n As Long)

  26.     Select Case n
  27.     Case 1
  28.         fabonacci = 1
  29.     Case 2
  30.         fabonacci = 2
  31.     Case Else
  32.         fabonacci = fabonacci(n - 1) + fabonacci(n - 2)
  33.     End Select
  34.    
  35.    
  36. End Function

复制代码



作业1

  1. Function modstr(ByVal area As Range) As String

  2.     ' rng 代表每个单元格, Sodd是String for odd,SNodd是 String for Not odd
  3.     Dim rng As Range, Sodd As String, SNodd As String
  4.    
  5.    
  6.     For Each rng In area
  7.    
  8.         If rng.Value Mod 2 = 1 Then
  9.             Sodd = Sodd & ";" & rng.Value
  10.         Else
  11.             SNodd = SNodd & ";" & rng.Value
  12.         End If
  13.         
  14.     Next
  15.    
  16.    
  17.     If Len(Sodd) > Len(SNodd) Then
  18.         modstr = Mid(Sodd, 2, Len(Sodd) - 1)
  19.     Else
  20.         modstr = Mid(SNodd, 2, Len(SNodd) - 1)
  21.     End If
  22.    
  23.    
  24. End Function
复制代码



作业2
  1. Option Explicit
  2. '工作表事件的默认事件,响应你选择的单元格区域
  3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  4.     'if target, area then exit sub
  5.     'if target.Count >1 then exit sub
  6.     Cells.Interior.Color = xlNone
  7.     'target 所在行与有值的区域交集的行变成黄色
  8.     'target 所在列与有值的区域交集的列变成黄色
  9.     Intersect(Rows(Target.Row), UsedRange).Interior.Color = vbYellow
  10.     Intersect(Columns(Target.Column), UsedRange).Interior.Color = vbYellow
  11.    
  12. End Sub

  13. '事件作业:事件响应,我们做一个聚光灯 行列都是黄色

复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-6 22:50:51 | 显示全部楼层
  1. '聚光灯作业
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.     Cells.Interior.Color = xlNone '把上一次点的颜色清空
  4.     If Intersect([a1].CurrentRegion, Target) Is Nothing Or Target.Count > 1 Then
  5.         Exit Sub
  6.     Else
  7.         Target.Offset(0, 1 - Target.Column).Resize(1, Target.CurrentRegion.Columns.Count).Interior.Color = vbYellow
  8.         Target.Offset(1 - Target.Row, 0).Resize(Target.CurrentRegion.Rows.Count, 1).Interior.Color = vbYellow
  9.     End If
  10. End Sub
  11. '提取奇偶数作业
  12. Function modstr(area As Range)
  13.     Application.Volatile
  14.     Dim i As Long, 奇数 As Long, 偶数 As Long
  15.     Dim rng As Range
  16.     For Each rng In area
  17.         If rng = 0 Or rng Mod 2 = 0 Then
  18.             偶数 = 偶数 + 1
  19.         Else
  20.             奇数 = 奇数 + 1
  21.         End If
  22.     Next
  23.     For i = 0 To area.Count - 1
  24.          Set rng = area.Offset(0, i).Resize(1, 1)

  25.         If 偶数 > 奇数 Then
  26.             If rng = 0 Or rng Mod 2 = 0 Then
  27.                 modstr = modstr & ";" & rng
  28.             End If
  29.         Else
  30.             If rng <> 0 And rng Mod 2 <> 0 Then
  31.                 modstr = modstr & ";" & rng
  32.             End If
  33.         End If

  34.     Next
  35.     modstr = Right(modstr, Len(modstr) - 1)
  36.    
  37. End Function
复制代码
回复 支持 反对

使用道具 举报

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

本版积分规则

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