8月19/20日 Excel函数实战100例 300集Office 2010微视频教程
8月9/10日 Excel函数实战技巧精粹 高效办公必会的Office实战技巧
8月28/29日 财务会计玩转Excel 网易云课堂-Excel数据透视表应用大全
Excel数据处理与分析实战技巧第1季
查看: 215|回复: 39

零基础学ExcelVBA 第十一期 第十课时作业贴

[复制链接]
发表于 2017-7-28 22:13:03 | 显示全部楼层 |阅读模式
本帖最后由 开心妙妙 于 2017-8-17 14:57 编辑

交作业的要求:

1、不需要附件,只需贴代码,说明你做的是哪道题
2、贴上的代码都需要缩进,并且关键语句要有注释
3、请在添加代码文字,那里添加代码,这样代码在楼层中显得赏心悦目。不知道怎样操作的小伙伴,可以参照看动画。
202642rdzv3seqns7csqxp.gif
回复

使用道具 举报

发表于 2017-8-1 12:44:36 | 显示全部楼层
  1. Sub 作业1()
  2. Dim sng As Range, cz As Range, nb As String
  3. Sheet11.Activate
  4. Set sng = Sheet11.UsedRange
  5.     With Sheet2
  6.     Set cz = sng.Find("南部")
  7.     cz.CurrentRegion.Copy .[a3]
  8.     .[b4:d7].Clear
  9.     .[a3] = "合计"
  10.      nb = cz.Address
  11.         Do
  12.         Set cz = sng.FindNext(cz)
  13.         cz.Offset(0, 1).Resize(4, 3).Copy
  14.         .[b4].PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
  15.         False, Transpose:=False
  16.         Loop Until nb = cz.Address
  17.     End With
  18. End Sub


  19. Sub 作业2()
  20. Dim sng As Range
  21. Set sng = Intersect([a4].CurrentRegion, [a4].Offset(2, 0).Resize(8, 6), [a4].Offset(0, 1).Resize(12, 4))
  22.     sng.Copy
  23.     [a23].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  24. End Sub


  25. Sub 作业3()
  26. Dim i As Long, 费用 As Long, 人数 As Long, 单价 As Long, 实际费用 As Long
  27. For i = 2 To [a1].CurrentRegion.Rows.Count
  28. 实际费用 = Range("a" & i)
  29. Do
  30.     人数 = 人数 + 1
  31.     Select Case 人数
  32.     Case Is <= 15
  33.     单价 = 500
  34.     Case Is <= 15 + (500 - 320) / 9
  35.     单价 = 500 - (人数 - 15) * 9
  36.     Case Else
  37.     单价 = 320
  38.     End Select
  39.     费用 = 单价 * 人数
  40.     Loop Until 实际费用 <= 费用
  41.     Select Case 费用
  42.     Case Is = 实际费用
  43.     Range("b" & i) = 人数
  44.     Range("c" & i) = 单价
  45.     Case Else
  46.     Range("b" & i) = "非本线路数据"
  47.      End Select
  48.      人数 = 0
  49.      费用 = 0
  50. Next
  51. End Sub
复制代码

点评

正确,思路很棒!  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-1 22:52:50 | 显示全部楼层
  1. Option Explicit

  2. '附加练习
  3. '题目一:使用Intersect,表示下表绿色区域(引用黑框内的单元格区域b6:e13)
  4. Sub testintersect()

  5.     Intersect(Range("a1:e13"), Range("b6:e20")).Select
  6.    
  7. End Sub
  8. '题目二:将绿色区域粘贴到下方和黑框内(a23:d30),仅保留值
  9. Sub 选择性粘贴数值()
  10.     Range("B6:E13").Copy
  11.     Range("A23").PasteSpecial Paste:=xlPasteValues
  12. End Sub


  13. Option Explicit


  14. '第一题:题目要求:在统计表的A3开始生成如图的合计数据:

  15. '请注意开始统计表应该是一张空表,即所有的数据均要求动态生成。

  16. '小提示: 本题不需要使用任何超过单元格操作外的任何高级技能即可完美实现
  17. Sub 水果统计()
  18.     Dim i&, j&, area As Range, fangwei As String, rng As Range
  19.     Application.ScreenUpdating = False                             '关闭屏幕更新
  20.    
  21.     Sheets("销售表").Activate                   '将销售表作为当前活动工作表
  22.     Sheet2.Range("a3").CurrentRegion.ClearContents '清除a3区域的旧内容
  23.     Range("a3:d7").Copy Sheet2.Range("a3")
  24.    
  25.     With Sheet2
  26.         .[a3] = "合计"
  27.         .[a3].Offset(1, 1).Resize(4, 3).ClearContents              ' 清除数值区域
  28.         Set rng = .[a4]
  29.         Set rng = Range(Range("a3"), Range("d" & Rows.Count).End(xlUp)).Find(rng) 'find查找rng
  30.         fangwei = rng.Address                                               '将查找到的rng位置赋值变量
  31.         
  32.         Do
  33.             Set rng = Range(Range("a3"), Range("d" & Rows.Count).End(xlUp)).FindNext(rng)
  34.                                                                             '查找区域内rng值的位置
  35.             If Not rng Is Nothing Then
  36.                 rng.Offset(, 1).Resize(4, 3).Copy                        '复制后选择性粘贴加法求值
  37.                 .Range("b4").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
  38.             End If
  39.         
  40.         Loop Until rng.Address = fangwei               '符合位置与首次出现位置相同时跳出循环
  41.    
  42.     End With
  43.     Application.ScreenUpdating = True
  44. End Sub




  45. Sub 旅行社数据整理1()
  46.     Dim i&, j&
  47.     For i = 2 To [a1].CurrentRegion.Rows.Count
  48.         For j = 320 To 500 Step 9
  49.         
  50.             If Cells(i, 1) Mod j = 0 _
  51.                 And ((Cells(i, 1) / j > 15 And j < 500) _
  52.                 Or (Cells(i, 1) / j <= 15 And j = 500)) Then
  53.                
  54.                 Cells(i, 2) = Cells(i, 1) / j
  55.                 Cells(i, 3) = j
  56.                
  57.             End If
  58.         Next
  59.         If Cells(i, 3) = "" Then
  60.             Cells(i, 2) = "非本线路数据"
  61.         End If
  62.     Next

  63. End Sub
复制代码


点评

正确,赞!旅行社数据整理1好棒的思路,赞  发表于 5 天前

评分

参与人数 1登攀 +5 收起 理由
开心妙妙 + 5 赞一个!

查看全部评分

回复 支持 反对

使用道具 举报

发表于 2017-8-2 19:10:58 | 显示全部楼层
本帖最后由 yiqian11 于 2017-8-5 23:34 编辑
  1. Sub statistics()
  2.     Dim i As Long, n As Long
  3.     Sheets("统计表").Range("a3").CurrentRegion.Rows.ClearContents
  4.     Sheets("销售表").Activate
  5.     Range("a3").CurrentRegion.Rows.Copy Sheets("统计表").Range("a3")
  6.     n = 6
  7.     For i = 1 To 3
  8.         With Sheets("统计表")
  9.             Range("a3").Offset(1, 1).Offset(n, 0).Resize(4, 3).Copy
  10.             .Range("a3").Offset(1, 1).PasteSpecial operation:=xlAdd
  11.         End With
  12.         n = n + i + 6
  13.     Next
  14. End Sub

  15. Sub areas()
  16.    Intersect([a4].CurrentRegion, Range("a23").Offset(-17, 1).Resize(8, 4)).Interior.Color = vbGreen
  17.    Intersect([a4].CurrentRegion, Range("a23").Offset(-17, 1).Resize(8, 4)).Copy
  18.    Range("a23").PasteSpecial operation:=xlNone
  19. End Sub

  20. Sub travel()
  21.     Dim groupcost As Double, singlecost As Double, numpeople As Long, r As Long
  22.     For r = 8 To Range("a1").CurrentRegion.Rows.Count
  23.         singlecost = 500
  24.         If Cells(r, 1).Value - singlecost * 15 > 0 Then
  25.             numpeople = 15
  26.             Do Until singlecost = 320 Or Cells(r, 1).Value <= singlecost * numpeople
  27.                 singlecost = singlecost - 9
  28.                 numpeople = numpeople + 1
  29.                 groupcost = Cells(r, 1).Value - singlecost * numpeople
  30.                 Debug.Print singlecost
  31.             Loop
  32.             Select Case groupcost
  33.             Case Is >= 320
  34.                     numpeople = numpeople + groupcost / 320
  35.                     Cells(r, 1).Offset(, 1).Value = numpeople
  36.             Case Is < 0
  37.                  Cells(r, 1).Offset(, 1).Value = "非本线路数据"
  38.             Case Is = 0
  39.                Cells(r, 1).Offset(, 1).Value = numpeople
  40.             End Select
  41.         Else
  42.             Cells(r, 1).Offset(, 1).Value = Cells(r, 1) / 500
  43.         End If
  44.     Next
  45. End Sub
复制代码


点评

travel,结果不正确,思路也不对,可看楼上的思路答案  发表于 5 天前
areas,未按要求实现,要求是仅保留值,你的是格式与值一起copy了  发表于 5 天前
statistics结果正确, 此方法不建议,不够灵活性,比较建议用find方法  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-2 19:13:30 | 显示全部楼层
  1. Sub statistics()
  2.     Dim i As Long, n As Long
  3.     Sheets("统计表").Range("a3").CurrentRegion.Rows.ClearContents
  4.     Sheets("销售表").Activate
  5.     Range("a3").CurrentRegion.Rows.Copy Sheets("统计表").Range("a3")
  6.     n = 6
  7.     For i = 1 To 3
  8.         With Sheets("统计表")
  9.             Range("a3").Offset(1, 1).Offset(n, 0).Resize(4, 3).Copy
  10.             .Range("a3").Offset(1, 1).PasteSpecial operation:=xlAdd
  11.         End With
  12.         n = n + i + 6
  13.     Next
  14. End Sub

  15. Sub areas()
  16.    intersect([a4].CurrentRegion, Range("a23").Offset(-17, 1).Resize(8, 4)).Interior.Color = vbGreen
  17.    intersect([a4].CurrentRegion, Range("a23").Offset(-17, 1).Resize(8, 4)).Copy
  18.    Range("a23").PasteSpecial operation:=xlNone
  19. End Sub

  20. Sub travel()
  21.     Dim groupcost As Double, singlecost As Double, numpeople As Long, r As Long
  22.     For r = 8 To Range("a1").CurrentRegion.Rows.Count
  23.         singlecost = 500
  24.         If Cells(r, 1).Value - singlecost * 15 > 0 Then
  25.             numpeople = 15
  26.             Do Until singlecost = 320 Or Cells(r, 1).Value <= singlecost * numpeople
  27.                 singlecost = singlecost - 9
  28.                 numpeople = numpeople + 1
  29.                 groupcost = Cells(r, 1).Value - singlecost * numpeople
  30.                 Debug.Print singlecost
  31.             Loop
  32.             Select Case groupcost
  33.             Case Is >= 320
  34.                     numpeople = numpeople + groupcost / 320
  35.                     Cells(r, 1).Offset(, 1).Value = numpeople
  36.             Case Is < 0
  37.                  Cells(r, 1).Offset(, 1).Value = "非本线路数据"
  38.             Case Is = 0
  39.                Cells(r, 1).Offset(, 1).Value = numpeople
  40.             End Select
  41.         Else
  42.             Cells(r, 1).Offset(, 1).Value = Cells(r, 1) / 500
  43.         End If
  44.     Next
  45. End Sub
复制代码
回复 支持 反对

使用道具 举报

发表于 2017-8-3 14:59:01 | 显示全部楼层
本帖最后由 cynthiashi 于 2017-8-3 20:46 编辑

Sub answer731_作业1()
    Dim rng As Range, firstadd As String
    With Sheets("统计表")
    .Cells.Clear
    .[a3] = "合计"
    Set rng = Sheets("销售表").UsedRange.Find("1月")
    rng.Resize(1, 3).Copy .Range("a3").Offset(0, 1)
    rng.Offset(1, -1).Resize(4, 1).Copy .Range("a3").Offset(1, 0)
    firstadd = rng.Address
    Set rng = Sheets("销售表").UsedRange.FindNext(rng)
    rng.Offset(1, 0).Resize(4, 3).Copy
    .Range("a3").Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
        Do Until rng.Address = firstadd
            Set rng = Sheets("销售表").UsedRange.FindNext(rng)
            rng.Offset(1, 0).Resize(4, 3).Copy
            .Range("a3").Offset(1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
        Loop
    End With
        
End Sub



Sub answer731_作业2_1()
   
    Dim rng1 As Range, rng2 As Range, rng As Range
    Set rng1 = Range([a4], Cells([a4].CurrentRegion.Rows.Count + 1, [a4].CurrentRegion.Columns.Count - 1))
    Set rng2 = Range([a4].Offset(2, 1), Cells([a4].CurrentRegion.Rows.Count + 3, [a4].CurrentRegion.Columns.Count))
    Set rng = Intersect(rng1, rng2)
    rng.Select
        
End Sub
Sub answer731_作业2_2()
   
    Dim rng1 As Range, rng2 As Range, rng As Range
    Set rng1 = Range([a4], Cells([a4].CurrentRegion.Rows.Count + 1, [a4].CurrentRegion.Columns.Count - 1))
    Set rng2 = Range([a4].Offset(2, 1), Cells([a4].CurrentRegion.Rows.Count + 3, [a4].CurrentRegion.Columns.Count))
    Set rng = Intersect(rng1, rng2)
    rng.Copy
    Range("a23").PasteSpecial Paste:=xlPasteValues
   
End Sub




Sub answer731_作业3()
    Dim i&, headcount&, unitfee&, totalfee&
    For i = 2 To [a1].CurrentRegion.Rows.Count
        totalfee = Range("a" & i)
        If totalfee Mod 500 = 0 And totalfee \ 500 <= 15 Then
            Range("b" & i) = totalfee \ 500
            Range("c" & i) = 500
        ElseIf totalfee Mod 320 = 0 And totalfee \ 500 > 15 Then
            Range("b" & i) = totalfee \ 320
            Range("c" & i) = 320
        End If
        headcount = 15
        unitfee = 500
        Do
            headcount = headcount + 1
            unitfee = unitfee - 9
            If headcount * unitfee = totalfee Then
                Range("b" & i) = headcount
                Range("c" & i) = unitfee
            End If
        Loop Until unitfee < 320
        If Range("b" & i) = "" Then
            Range("b" & i) = "非本线路数据"
        End If
    Next
   
End Sub



点评

结果正确,代码思路赞!  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-3 22:15:35 | 显示全部楼层
  1. Sub 水果销售统计()

  2.     With Sheets("统计表")
  3.         Sheets("销售表").Range("A3:D7").Copy .Range("A3")
  4.         .Range("A3") = "合计"
  5.         .Range("B4:D7").ClearContents
  6.     Dim rng1 As Range, rng2 As Range, firstAdd As String
  7.         Set rng1 = Sheets("销售表").UsedRange.Find("南部")
  8.         Set rng2 = .Range("B4:D7")
  9.         If Not rng1 Is Nothing Then
  10.             firstAdd = rng1.Address
  11.             Do
  12.                 rng1.Offset(0, 1).Resize(4, 3).Copy
  13.                 rng2.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
  14.                 Set rng1 = Sheets("销售表").UsedRange.FindNext(rng1)
  15.             Loop Until rng1.Address = firstAdd
  16.         End If
  17.     End With
  18.    
  19. End Sub


  20. Sub 交集()

  21. Dim rng As Range

  22. Set rng = Intersect(Range("A4").CurrentRegion, Range("B6:E13"))
  23.     rng.Copy
  24.     Range("A23").PasteSpecial Paste:=xlPasteValues

  25. End Sub

  26. Sub 旅行团()

  27. Dim i As Long, n As Long, 团费 As Long, 人数 As Long, 旅行费 As Long
  28.    
  29.     Do
  30.         Select Case 人数
  31.           Case Is <= 15
  32.           团费 = 500
  33.           旅行费 = 团费 * 人数
  34.           Case Else
  35.           团费 = 500 - (人数 - 15) * 9
  36.             If 团费 > 320 Then
  37.             旅行费 = 团费 * 人数
  38.             Else
  39.             团费 = 320
  40.             旅行费 = 团费 * 人数
  41.             End If
  42.         End Select
  43.         
  44.         n = Cells(2, 1)
  45.         For i = 2 To Range("A2").CurrentRegion.Rows.Count
  46.             If Cells(i + 1, 1) > n Then
  47.                 n = Cells(i + 1, 1)
  48.                 Debug.Print n
  49.             End If
  50.             If Cells(i, 1) = 旅行费 Then
  51.                 Cells(i, 2) = 人数
  52.                 Cells(i, 3) = 团费
  53.             End If
  54.         Next
  55.         人数 = 人数 + 1
  56.     Loop Until 人数 > n / 320
  57.          For i = 2 To Range("A2").CurrentRegion.Rows.Count
  58.             If Cells(i, 2) = "" Then
  59.             Cells(i, 2) = "非本线路数据"
  60.             End If
  61.         Next
  62. End Sub
复制代码

点评

结果正确,不错  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-4 09:30:44 | 显示全部楼层
  1. '作业1
  2. Sub 天使之城水果公司销售统计()

  3.     Dim rng As Range, rng1 As Range, fdd As String
  4.     Set rng = Sheet11.UsedRange.Find("1月")
  5.     Sheet2.Range("a3:d7").Clear
  6.     Set rng1 = rng.CurrentRegion
  7.     rng1.Copy Sheet2.Range("a3")
  8.     Sheet2.Range("a3") = "合计"
  9.     fdd = rng.Address
  10.     If Not rng Is Nothing Then
  11.         Do
  12.             Set rng = Sheet11.UsedRange.FindNext(rng)
  13.             If fdd <> rng.Address Then
  14.                Set rng1 = rng.Offset(1, 0).Resize(4, 3)
  15.                 rng1.Copy
  16.                 Sheet2.Range("b4").PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
  17.                 :=False, Transpose:=False
  18.            End If
  19.         Loop Until fdd = rng.Address
  20.    
  21.     End If
  22. End Sub
复制代码
  1. Sub 作业2题目1()
  2.     Dim rng As Range
  3.     Set rng = Intersect(Range("a4:f15"), Range("b4:e15"), Range("a6:f13"))
  4.     rng.Interior.Color = vbGreen
  5. End Sub
复制代码
  1. Sub 作业2题目2()
  2.     Dim rng As Range
  3.     Set rng = Intersect(Range("a4:f15"), Range("b4:e15"), Range("a6:f13"))
  4.    
  5.     rng.Copy
  6.     Range("a23").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
  7. End Sub
复制代码
  1. Sub 帮不靠谱旅行社记帐()
  2.     Dim 每人团费 As Long, i As Long, j As Long, 最大人数 As Long
  3.     Dim 总团费 As Long, 区间每人团费 As Long, 每人优惠 As Long
  4.     每人团费 = 500
  5.     每人优惠 = 9
  6.     For j = 2 To Range("a1").CurrentRegion.Rows.Count
  7.     最大人数 = Range("a" & j) \ 320
  8.         For i = 1 To 最大人数 + 1
  9.             If i <= 15 Then
  10.                 总团费 = i * 每人团费
  11.                 If 总团费 = Range("a" & j) Then
  12.                     Range("b" & j) = i
  13.                     Range("c" & j) = 每人团费
  14.                     Exit For
  15.                 ElseIf 总团费 > Range("a" & j).Value Then
  16.                     Range("b" & j) = "非本团线路"
  17.                     Exit For
  18.                 End If
  19.             ElseIf i > 15 Then
  20.                 区间每人团费 = 每人团费 - (i - 15) * 每人优惠
  21.                 If 区间每人团费 >= 320 Then
  22.                     总团费 = i * 区间每人团费
  23.                 Else
  24.                     区间每人团费 = 320
  25.                     总团费 = i * 区间每人团费
  26.                 End If
  27.                 If 总团费 = Range("a" & j) Then
  28.                     Range("b" & j) = i
  29.                     Range("c" & j) = 区间每人团费
  30.                     Exit For
  31.                 ElseIf 总团费 > Range("a" & j).Value Then
  32.                     Range("b" & j) = "非本团线路"
  33.                     Exit For
  34.                 End If
  35.             End If
  36.         Next
  37.     Next
  38. End Sub
复制代码


点评

结果正确,不错  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-4 16:32:02 | 显示全部楼层
Sub 水果公司销售统计()
    Dim rng As Range, firstadd
    Sheet2.UsedRange.Clear
    Set rng = Range("a3").CurrentRegion.Find("1月")
         firstadd = rng.Address
        rng.CurrentRegion.Copy Destination:=Sheets(2).[a3]
        Sheets(2).[a3].CurrentRegion.Offset(1, 1).Clear
        Sheets(2).Range("a3") = "合计"
    If Not rng Is Nothing Then
        Do
           Set rng = Sheets(1).UsedRange.FindNext(after:=rng)
           rng.CurrentRegion.Offset(1, 1).Resize(4, 3).Copy
           Sheets(2).[a3].CurrentRegion.Offset(1, 1).PasteSpecial Operation:=xlPasteSpecialOperationAdd
        Loop Until rng.Address = firstadd
    End If

End Sub

Sub 交集和并集练习作业()
    Dim rng As Range
    Range("b6:e13").ClearFormats
    With Sheet1
     Intersect(Range("b6:e13"), Range("a4:f15")).Interior.Color = vbGreen
     Range("b6:e13").Copy
     Range("a23").PasteSpecial (xlPasteValues)
    End With
End Sub

Sub 旅行社收费()
    Dim 团员人数 As Integer, 每人团费 As Long, i&, 团费&, 费用合计#
    For i = 2 To 8
            For 团员人数 = 1 To 15
               If Range("a" & i) = 团员人数 * 500 Then
                    Range("b" & i) = 团员人数
                    Range("c" & i) = 500
                    Exit For
                End If
            Next
            团费 = 500
            For 团员人数 = 15 To Range("a" & i) / 320
                If Range("a" & i) = 团员人数 * 团费 Then
                    Range("b" & i) = 团员人数
                    Range("c" & i) = 团费
                    Exit For
                ElseIf 团费 >= 328 Then 团费 = 团费 - 9
                End If
            Next
        If Range("b" & i) = "" Then
            Range("b" & i) = "非本线路数据"
        End If
    Next

End Sub

点评

结果正确,不错  发表于 5 天前
回复 支持 反对

使用道具 举报

发表于 2017-8-4 17:58:19 | 显示全部楼层
  1. Option Explicit

  2. Sub 单元格交并集练习()
  3.     Dim area1 As Range, area2 As Range, area3 As Range, intersectarea As Range
  4.    
  5.     '从A3出发表示绿色区域
  6.     Set area1 = Range("a3").Offset(1, 0).CurrentRegion
  7.     Set area2 = Range(Range("a3").Offset(1, 0).CurrentRegion.Rows(3), Range("a3").Offset(1, 0).CurrentRegion.Rows(10))
  8.     Set area3 = Range(Range("a3").Offset(1, 0).CurrentRegion.Columns(2), Range("a3").Offset(1, 0).CurrentRegion.Columns(5))
  9.     Set intersectarea = Intersect(Intersect(area1, area2), area3)
  10.    
  11.     '粘贴绿色区域的值
  12.     intersectarea.Copy
  13.     Range("A23").PasteSpecial Paste:=xlPasteValues
  14. End Sub





  15. Sub 水果销售统计()
  16.     Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range
  17.     '复制粘贴第一个表格,包括标签和数据,并将标题改为合计
  18.     Set rng1 = Sheets("销售表").Range("a3").CurrentRegion
  19.     rng1.Copy
  20.     Sheets("统计表").Range("a3").PasteSpecial Paste:=xlPasteValues
  21.     Sheets("统计表").Range("a3") = "合计"
  22.     '用pastevalue-add复制第二个表格的数据区域到目标区域
  23.     Set rng2 = Sheets("销售表").Range("a3").Offset(7, 1).Resize(4.3)
  24.     rng2.Copy
  25.     Sheets("统计表").Range("b4").PasteSpecial Paste:=xlPasteAll, operation:=xlAdd
  26.     '用pastevalue-add复制第三个表格的数据区域到目标区域
  27.     Set rng3 = rng2.Offset(7, 0)
  28.     rng3.Copy
  29.     Sheets("统计表").Range("b4").PasteSpecial Paste:=xlPasteAll, operation:=xlAdd
  30.     '用pastevalue-add复制第四个表格的数据区域到目标区域
  31.     Set rng4 = rng3.Offset(8, 0)
  32.     rng4.Copy
  33.     Sheets("统计表").Range("b4").PasteSpecial Paste:=xlPasteAll, operation:=xlAdd
  34.    
  35. End Sub




  36. Sub 旅行社收费()
  37.     Dim i As Long, j As Long
  38.     '依次判断每个费用
  39.     For i = 2 To 8
  40.         '当费用小于7500时,每人团费一定是500,则人数是旅行社费用/团费。如果旅行社费用不是500的倍数,就不是本线路数据
  41.         If Cells(i, "a") < 7500 Then
  42.             If Cells(i, "a") Mod 500 = 0 Then
  43.                 Cells(i, "b") = Cells(i, "a") / 500
  44.                 Cells(i, "c") = 500
  45.             Else
  46.                 Cells(i, "c") = "非本线路数据"
  47.             End If
  48.         Else
  49.         '当费用在7500-11200之间时,团员人数一定在16-34之间,则每人团费是500-(人数-15)×9。如果人数×每人团费与旅行社不相等,就不是本线路数据
  50.             If Cells(i, "a") < 11200 Then
  51.                 For j = 16 To 34
  52.                     Cells(i, "c") = 500 - (j - 15) * 9
  53.                     If (Cells(i, "a") - j * Cells(i, "c")) = 0 Then
  54.                         Cells(i, "b") = j
  55.                         Exit For
  56.                     End If
  57.                 Next
  58.                 If j = 35 Then
  59.                     Cells(i, "b") = "非本线路数据"
  60.                     Cells(i, "c") = ""
  61.                 End If
  62.             '当费用大于11200时,每人团费一定是320,如果旅行社费用不是320的倍数就不是本线路数据
  63.             Else
  64.                 If Cells(i, "a") Mod 320 = 0 Then
  65.                     Cells(i, "b") = Cells(i, "a") / 320
  66.                     Cells(i, "c") = 320
  67.                 Else
  68.                     Cells(i, "b") = "非本线路数据"
  69.                 End If
  70.             End If
  71.         End If
  72.     Next
  73. End Sub

复制代码

点评

其它题目结果正确.  发表于 5 天前
水果销售统计:结果不正确,代码不正确,思路也不正确.去看楼上的同学的思路方法  发表于 5 天前
回复 支持 反对

使用道具 举报

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

本版积分规则

关闭

站长推荐上一条 /1 下一条

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