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

零基础VBA 第十期 第十四课时作业贴

[复制链接]
发表于 2018-3-21 21:20:02 | 显示全部楼层

  1. ‘聚光灯
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3. Dim area As Range
  4.     Cells.Interior.Color = xlNone
  5. Set area = Range("a1").CurrentRegion
  6. If Target.count > 1 Or Intersect(Range("a1").CurrentRegion, Target) Is Nothing Then Exit Sub
  7. Range("a1").CurrentRegion.Rows(Target.Row).Interior.Color = vbYellow
  8. Range("a1").CurrentRegion.Columns(Target.Column).Interior.Color = vbYellow
  9. End Sub
  10. ’自定义函数作业
  11. Function bili(num As Range)
  12. Dim rng As Range, snum As String, dnum As String
  13. For Each rng In num
  14.     If rng Mod 2 = 0 Then
  15.        dnum = dnum & rng & ";"
  16.     Else
  17.        snum = snum & rng & ";"
  18.     End If
  19. Next
  20. If Len(dnum) > Len(snum) Then
  21.    bili = Left(dnum, Len(dnum) - 1)
  22. Else
  23.    bili = Left(snum, Len(snum) - 1)
  24. End If
  25. End Function
  26. ‘星座作业
  27. Private Sub Worksheet_Change(ByVal Target As Range)
  28. Dim area As Range, rng As Range, fadress As String
  29. If Target.Address(0, 0) <> "B1" Then Exit Sub
  30. Range("a3").CurrentRegion.Offset(1, 0).ClearContents
  31. With Worksheets(1).Range("a2").CurrentRegion
  32. Set Target = .Find(Target)
  33. If Target Is Nothing Then Exit Sub
  34.    fadress = Target.Address(0, 0)
  35.    Do
  36.    .Rows(Target.Row).Copy Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
  37.    Set Target = .FindNext(Target)
  38.    Loop Until Target.Address(0, 0) = fadress
  39. End With
  40. End Sub
  41. ’根据需要提字符串
  42. Function getchar(str As String, num)
  43. Dim i As Long, charn As String
  44. Application.Volatile True
  45. For i = 1 To Len(str)
  46. charn = Mid(str, i, 1)
  47. Select Case num
  48.        Case 1
  49.        If charn Like "[0-9]" Then getchar = getchar & charn
  50.        Case 2
  51.         If charn Like "[A-Za-z]" Then getchar = getchar & charn
  52.        Case 3
  53.           If charn Like "[!0-9A-Za-z]" Then getchar = getchar & charn
  54. End Select
  55. Next
  56. If getchar = 0 Then getchar = ""
  57. End Function
复制代码



回复 支持 反对

使用道具 举报

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

本版积分规则

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