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

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

[复制链接]
发表于 2018-1-2 22:17:37 | 显示全部楼层 |阅读模式
本帖最后由 开心妙妙 于 2018-1-16 15:01 编辑

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

使用道具 举报

发表于 2018-1-4 09:30:39 | 显示全部楼层
  1. Function 不良总数(str As String)
  2.     Dim i As Long, j As Long, sum As Long
  3.     For i = 1 To Len(str)
  4.         If Mid(str, i, 1) Like "#" Then
  5.             j = i
  6.             Do Until Mid(str, i, 1) Like "#" = False
  7.                 If Mid(str, i, 1) Like "#" Then
  8.                 i = i + 1
  9.                 End If
  10.             Loop
  11.             sum = sum + Val(Mid(str, j, i - j))
  12.         End If
  13.     Next
  14.     不良总数 = sum
  15. End Function
  16. Private Sub Worksheet_Change(ByVal Target As Range)
  17.     If UCase(Target.Address(0, 0)) <> "B1" Then Exit Sub
  18.     Dim i As Long, j As Long
  19.     j = 3
  20.     Cells(4, 1).Resize(Range("a3").CurrentRegion.Rows.Count, 4).ClearContents
  21.     With Worksheets("sheet1")
  22.         For i = 3 To .Range("a1").CurrentRegion.Rows.Count
  23.             If .Cells(i, "d") = Target.Value Then
  24.                 j = j + 1
  25.                 Cells(j, "a") = .Cells(i, "a")
  26.                 Cells(j, "b") = .Cells(i, "b")
  27.                 Cells(j, "c") = .Cells(i, "c")
  28.                 Cells(j, "d") = .Cells(i, "d")
  29.             End If
  30.         Next
  31.     End With
  32. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-4 15:35:09 | 显示全部楼层
本帖最后由 sweet17tian 于 2018-1-6 17:13 编辑

星座

  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Dim sht1 As Worksheet, sht2 As Worksheet
  3.     Dim rng As Range
  4.     If Target.Address = [b1].Address Then
  5.         Set sht1 = Worksheets("sheet1")
  6.         Set sht2 = Worksheets("事件响应作业")
  7.         Set rng = sht1.Range("a2:d12")
  8.         Range("a3").CurrentRegion.ClearContents
  9.         With rng
  10.             .AutoFilter Field:=4, Criteria1:=[b1].Value
  11.             .SpecialCells(xlCellTypeVisible).Copy sht2.[a3]
  12.             .AutoFilter
  13.             
  14.         End With
  15.     Else
  16.         Exit Sub
  17.     End If
  18. End Sub


复制代码


复制代码


取数求和
  1. Sub 取数求和()
  2.     Dim str As String
  3.     Dim i As Long, j As Long, k As Long, l As Long, sum As Long
  4.     For l = 3 To 5
  5.     sum = 0
  6.     str = Cells(l, "g")
  7.         For i = 1 To Len(str)
  8.         If Mid(str, i, 1) Like "#" And Mid(str, i + 1, 1) Like "[!0-9A-Za-z]" Then
  9.             j = Mid(str, i, 1)
  10.             sum = sum + j
  11.         ElseIf Mid(str, i, 1) Like "#" And Mid(str, i + 1, 1) Like "#" Then
  12.             k = Mid(str, i, 1) * 10
  13.             j = Mid(str, i + 1, 1)
  14.             sum = sum + k + j
  15.            i = i + 2
  16.             
  17.         End If
  18.         Next
  19.     Cells(l, "f") = sum
  20.    
  21.     Next

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

使用道具 举报

发表于 2018-1-4 16:28:47 | 显示全部楼层
  1. '作业1:从字符串中自动提取数字然后求和
  2. Function BadV(str As Range)
  3.     Dim st@, i&, j&
  4.     For i = 1 To Len(str)
  5.         If Mid(str, i, 1) Like "#" Then
  6.             If Mid(str, i - 1, 1) Like "#" Then
  7.                 BadV = BadV - st
  8.                 st = st & Mid(str, i, 1)
  9.             Else
  10.                 st = Mid(str, i, 1)
  11.             End If
  12.             BadV = BadV + st
  13.         End If
  14.     Next
  15. End Function
  16. '作业2:选择星座
  17. Private Sub Worksheet_Change(ByVal Target As Range)
  18.     Dim j&, area, rng, r As Range
  19.     If Target.Address(0, 0) <> "B1" Then Exit Sub
  20.     [A3].CurrentRegion.Offset(1, 0).ClearContents
  21.     Set area = Sheet1.Range("A1").CurrentRegion
  22.     Set rng = Sheet1.Range("D3:D" & area.Rows.Count)
  23.     For Each r In rng
  24.         If r = [B1] Then
  25.             j = j + 1
  26.             r.Offset(, -3).Resize(, 4).Copy Cells(j + 3, 1)
  27.         End If
  28.     Next
  29. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-6 09:14:49 | 显示全部楼层
  1. Option Explicit
  2. '作业一我想从【不良明细】这一列中提取里面的不良数量,然后自动求和到【不良总数】里
  3. '比如:F3中的23我不想自己算出来,而是根据后面【不良明细】中自动求出来,而不良明细中多少不定,项目不定。
  4. Function sumNum(ByVal rng As Range)
  5. Dim i As Long, j As Long, a As String, b As String, c As String
  6.     i = 1
  7.     Do Until i > Len(rng)
  8.         c = 0
  9.         a = Mid(rng, i, 1)
  10.         If a Like "#" Then
  11.             c = a
  12.             j = i + 1
  13.             Do Until Not IsNumeric(c)
  14.                 b = Mid(rng, j, 1)
  15.                 c = c & b
  16.                j = j + 1
  17.                i = j
  18.             Loop
  19.         End If
  20.         sumNum = sumNum + Val(c)
  21.         i = i + 1
  22.     Loop
  23. End Function
  24. Sub sum4()
  25.     Dim i As Long, a As String, c As String, rng As String, sum2 As Long
  26.     rng = "剪PIN高2个,剪PIN低14个,磁芯错位4个,结线不良1个,绕线状态不良2个"
  27.     i = 1
  28.     Do Until i > Len(rng)
  29.         c = 0
  30.         a = Mid(rng, i, 1)
  31.         If a Like "#" Then
  32.             c = Val(Mid(rng, i))
  33.         End If
  34.         sum2 = sum2 + c
  35.         i = i + Len(c)
  36.     Loop
  37.     MsgBox sum2
  38. End Sub
  39. Function badNum(rng)
  40.     Dim i As Long, a As String, c As String
  41.     i = 1
  42.     Do Until i > Len(rng)
  43.         c = 0
  44.         a = Mid(rng, i, 1)
  45.         If a Like "#" Then
  46.             c = Val(Mid(rng, i))
  47.         End If
  48.         badNum = badNum + c
  49.         i = i + Len(c)
  50.     Loop
  51. End Function
  52. '作业一,当我简化我的代码重新写时,当我用SUB过程来写是可以得出正确的结果,但我用FUNCTION的话,结果不对,麻烦老师帮忙看看是哪出错。而且我用FUNCTION基本都会出现这样的问题
  53. '作业二,星座问题
  54. Private Sub Worksheet_Change(ByVal Target As Range)
  55.     Dim i As Long, j As Long
  56.     Application.ScreenUpdating = False
  57.     If UCase(Target.Address(0, 0)) <> "B1" Then Exit Sub
  58.     Range("a4:d13").ClearContents
  59.     j = 4
  60.     With Sheets("sheet1")
  61.         For i = 3 To .[a2].CurrentRegion.Rows.Count
  62.             If .Cells(i, "d") = [b1] Then
  63.                 .Cells(i, "d").CurrentRegion.Rows(Cells(i, "d").Row).Copy Cells(j, "a")
  64.                 j = j + 1
  65.             End If
  66.         Next
  67.     End With
  68. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-7 20:07:39 | 显示全部楼层
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim i%, j%, k%, l%, m%
  3.     If Target.Address(0, 0) = "B1" Then
  4.     i = Worksheets("sheet1").Range("a1").CurrentRegion.Rows.Count
  5.     m = 4
  6.     Range("a4:d13").ClearContents
  7.      For l = 1 To 4
  8.         For j = 3 To i
  9.    
  10.                 If Range("b1") = Worksheets("sheet1").Range("d" & j) Then
  11.                
  12.                     Cells(m, l) = Worksheets("sheet1").Cells(j, l)
  13.                         m = m + 1
  14.                 End If
  15.             Next
  16.             m = 4
  17.         Next
  18.     End If
  19. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-7 22:31:56 | 显示全部楼层
我是民航骄子

  1. ‘作业1


  2. Option Explicit

  3. Function numbers(ByVal str As String) As Long

  4.     numbers = 0
  5.    
  6.     Dim char As String, text As String
  7.    
  8.     Dim i As Long
  9.    
  10.     For i = 1 To Len(str)
  11.    
  12.         char = Mid(str, i, 1)
  13.         
  14.         If char Like "#" Then
  15.             text = text & char
  16.         Else
  17.             numbers = numbers + Val(text)
  18.             text = ""
  19.         End If
  20.         

  21.    
  22.     Next

  23. End Function

复制代码




  1. ’ 作业2

  2. Option Explicit

  3. Private Sub Worksheet_Change(ByVal Target As Range)

  4.     If UCase(Target.Address(0, 0)) <> "B1" Then
  5.    
  6.         Exit Sub
  7.    
  8.     Else
  9.         
  10.         Application.EnableEvents = False
  11.         
  12.         Range("A4", "D13").ClearContents
  13.         
  14.         
  15.         Dim str As String
  16.         
  17.         str = Target.Value
  18.         
  19.         With Worksheets("sheet1")
  20.         
  21.             Dim rng As Range, area As Range
  22.             
  23.             
  24.             Set area = .Range("D3", UCase(Cells(.Range("a1").CurrentRegion.Rows.Count, .Range("a1").CurrentRegion.Columns.Count).Address(0, 0)))
  25.             
  26.             
  27.             Dim i As Long
  28.             i = 4
  29.             
  30.             For Each rng In area
  31.                 If rng.Value = str Then
  32.                     rng.Offset(0, -3).Resize(1, 4).Copy Cells(i, 1)
  33.                     i = i + 1
  34.                     
  35.                 End If
  36.             Next
  37.             
  38.                
  39.         End With
  40.    
  41.         Application.EnableEvents = True
  42.         
  43.     End If
  44.    
  45.    
  46. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-11 18:24:55 | 显示全部楼层
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     If UCase(Target.Address(0, 0)) <> "B1" Then
  3.         Exit Sub
  4.     Else
  5.         [A3].CurrentRegion.ClearContents
  6.         Sheets("15-星座数据源").Range("A2").AutoFilter Field:=4, Criteria1:=Target
  7.         Sheets("15-星座数据源").Range("A2").CurrentRegion.Copy _
  8.         Sheets("15-星座事件响应").Range("A3")
  9.         Sheets("15-星座数据源").Range("A2").AutoFilter
  10.     End If
  11. End Sub


  12. Sub 不良数量()
  13.     Sheets("15-不良总数").Activate
  14.     Dim 不良明细 As String, i As Long, j As Long, sum As Long
  15.     For i = 3 To Range("G2").End(xlDown).Row
  16.     sum = 0
  17.     不良明细 = Range("G" & i)
  18.         For j = 1 To Len(不良明细)
  19.             If Mid(不良明细, j, 1) Like "#" Then
  20.                 sum = sum + Mid(不良明细, j, 位数(不良明细, j))
  21.                 j = j + 位数(不良明细, j)
  22.             End If
  23.         Next
  24.     Range("F" & i) = sum
  25.    
  26.     Next
  27. End Sub

  28. Function 位数(区域 As String, 起始位置 As Long)
  29.     Dim n As Long
  30.     位数 = 1
  31.     For n = 1 To Len(区域) - 起始位置
  32.         If Mid(区域, 起始位置 + n, 1) Like "#" Then
  33.             位数 = 位数 + 1
  34.         Else
  35.             Exit For
  36.         End If
  37.     Next
  38. End Function
复制代码
回复 支持 反对

使用道具 举报

发表于 2018-1-20 22:44:15 | 显示全部楼层
  1. 星座
  2. Private Sub Worksheet_Change(ByVal Target As Range)
  3.     If UCase(Target.Address(0, 0)) <> "B1" Then Exit Sub
  4.     Dim i As Long, time As Long, r As Long
  5.     r = Range("a3").CurrentRegion.Rows.Count
  6.         Range("a4:d" & 3 + r).ClearContents
  7.         For i = 3 To 12
  8.             If Sheets("sheet1").Range("d" & i) = Range("b1") Then
  9.                 Sheets("sheet1").Range("a" & i).Resize(1, 4).Copy Range("a" & 4 + time)
  10.                 time = time + 1
  11.             End If
  12.         Next
  13.         time = 0
  14. End Sub
  15. ‘=====================================================================================
  16. 不良品统计
  17. Function Badproduct(area As Range)
  18.     Dim i As Long, time As Long, sum As Long, Char1 As String, char2 As String
  19.     For i = 1 To Len(area)
  20.         Char1 = Mid(area, i, 1)
  21.         If Char1 Like "#" Then
  22.             Do
  23.                 char2 = char2 & Mid(area, i + time, 1)
  24.                 time = time + 1
  25.             Loop While Mid(area, i + time, 1) Like "#"
  26.             i = i + time - 1
  27.         End If
  28.         sum = sum + Val(char2)
  29.         char2 = ""
  30.         time = 0
  31.     Next
  32.     Badproduct = sum
  33. End Function
复制代码
回复 支持 反对

使用道具 举报

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

本版积分规则

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