Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 29701|回复: 56

[通知] 统计VBA学习小组正式组的积分帖之作业上交贴(第14周)

  [复制链接]
发表于 2012-3-27 21:54 | 显示全部楼层 |阅读模式
活动类型:
作业上交
开始时间:
2012-3-28 21:52 至 2012-4-3 21:52 商定
活动地点:
VBA学习小组
性别:
不限
已报名人数:
50

本帖最后由 兰色幻想 于 2012-4-17 17:45 编辑

说明:
统计帖每个学员只能跟帖回复一次,也就是在原来回复楼层的基础上点编缉,不要一个链接一层楼,否则不计算积分。

各小组学员上交作业时,一定要点击我要参加注明自己的新组编号和论坛ID如果点击过我要参加但没有跟帖提交作业的,扣该学员5积分;如果跟帖提交了作业,但没有点我要参加的,不给予评分。

请各学员看清上面的说明,免得被扣了分分!
本帖为仅楼主可见帖,直接回复即可!
作业链接:http://www.excelpx.com/thread-231668-1-1.html

暂未通过 (50 人)

  留言 申请时间
ls 2012-4-9 23:49
szczm121 2012-4-9 14:06
ybchxj2010 2012-4-5 21:21
亦铭 2012-4-5 21:02
@wsm 2012-4-5 17:04
zjyxp 2012-4-4 17:58
开心妙妙 2012-4-3 16:41
wenchduan 2012-4-3 15:01
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-3-28 10:38 | 显示全部楼层
C12:hrpotter
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim i As Integer, j As Integer
  4.     Dim s1, s2
  5.     i = Range("a65536").End(xlUp).Row
  6.     Cells(i + 1, 1) = "小计"
  7.     For j = i To 3 Step -1
  8.         If Month(Cells(j, 1)) <> Month(Cells(j - 1, 1)) Then
  9.             Rows(j).Insert
  10.             Cells(j, 1) = "小计"
  11.         End If
  12.     Next
  13.     For i = 2 To Range("a65536").End(xlUp).Row
  14.         s1 = s1 + Cells(i, 3)
  15.         s2 = s2 + Cells(i, 4)
  16.         If Cells(i, 1) = "小计" Then
  17.             Cells(i, 3) = s1
  18.             Cells(i, 4) = s2
  19.             s1 = 0
  20.             s2 = 0
  21.         End If
  22.     Next
  23. End Sub
  24. Private Sub CommandButton2_Click()
  25.     Dim i As Integer
  26.     i = Range("a65536").End(xlUp).Row
  27.     Range("c2:c" & i).SpecialCells(xlCellTypeBlanks).Offset(, 2) = 1
  28. End Sub
  29. Private Sub CommandButton3_Click()
  30.     Dim i As Integer
  31.     i = Range("a65536").End(xlUp).Row
  32.     Range("e2:e" & i).ClearContents
  33.     Range("b2:b" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  34. End Sub
复制代码
C12-hrpotter-第11课作业题.rar (22.13 KB, 下载次数: 36)

评分

参与人数 1金币 +8 收起 理由
兰色幻想 + 8 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-28 14:19 | 显示全部楼层
Private Sub CommandButton1_Click()
Dim x As Integer
Dim m, n As Integer
x = 1
m = 2
With Sheets(1)
Do
x = x + 1
If VBA.Month(.Cells(x, 1)) <> VBA.Month(.Cells(x + 1, 1)) Then
  n = x
Rows(x + 1).Insert shift:=xlDown
.Cells(x + 1, 1) = "合计"
.Cells(x + 1, 3) = Application.WorksheetFunction.Sum(Range(Cells(m, 3), Cells(n, 3)))
.Cells(x + 1, 4) = Application.WorksheetFunction.Sum(Range(Cells(m, 4), Cells(n, 4)))
  m = n + 2
  x = x + 1
End If
Loop While .Cells(x, 1) <> ""
End With
End Sub

Private Sub CommandButton2_Click()
Application.Intersect(Columns(5), Range("c2", "c" & Range("c65536").End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow) = 1
End Sub
Private Sub CommandButton3_Click()
Range("e2", "e" & Range("e65536").End(3).Row).ClearContents
Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

第11课作业题.rar (22.6 KB, 下载次数: 15)

评分

参与人数 1金币 +8 收起 理由
兰色幻想 + 8 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-28 14:33 | 显示全部楼层
E学委:sunjing-zxl
第11课作业题-E学委-sunjing-zxl.rar (23.84 KB, 下载次数: 5)
回复

使用道具 举报

发表于 2012-3-28 19:48 | 显示全部楼层

  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3. Dim r As Integer, i As Integer, Ms As Integer, x As Integer, TotC As Integer, TotD As Integer
  4. Rows(Range("A65536").End(3).Row + 1).Insert shift:=xlDown
  5. Ms = Month(Cells(Range("A65536").End(3).Row, 1))
  6. r = Range("A65536").End(3).Row + 1
  7. For i = Range("a65536").End(3).Row To 2 Step -1
  8. x = Month(Cells(i, 1))
  9. If Ms <> Month(Cells(i, 1)) Then
  10. Cells(r, 1) = "小计"
  11. Cells(r, 3) = TotC: TotC = 0
  12. Cells(r, 4) = TotD: TotD = 0
  13. Ms = x
  14. Rows(i + 1).Insert shift:=xlDown
  15. r = i + 1
  16. End If
  17. TotC = TotC + Cells(i, 3): TotD = TotD + Cells(i, 4)
  18. Next
  19. Cells(r, 1) = "小计"
  20. Cells(r, 3) = TotC: TotC = 0
  21. Cells(r, 4) = TotD: TotD = 0
  22. CommandButton3.Enabled = True
  23. CommandButton1.Enabled = False
  24. End Sub

  25. Private Sub CommandButton2_Click()
  26. Range("C2:C" & Range("A65536").End(3).Row).SpecialCells(xlCellTypeBlanks).Offset(0, 2).Value = 1
  27. End Sub
  28. Private Sub CommandButton3_Click()
  29. Range("B2:B" & Range("a65536").End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  30. Range("E2:E" & Range("A65536").End(3).Row).Value = ""
  31. CommandButton1.Enabled = True
  32. CommandButton3.Enabled = False
  33. End Sub


  34. 第11课作业题C17-Happym8888.rar (16.25 KB, 下载次数: 8)


复制代码

评分

参与人数 1金币 +8 收起 理由
兰色幻想 + 8 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-28 20:51 | 显示全部楼层
Private Sub CommandButton1_Click()
    Dim x, y, z, a, b, c As Integer
        y = Range("a65536").End(xlUp).Row
            For x = y To 3 Step -1
                If VBA.Month(Cells(x, 1)) <> VBA.Month(Cells(x - 1, 1)) Then
                   Cells(x, 1).EntireRow.Insert
                End If
             Next x
            z = Range("a65536").End(xlUp).Row + 1
            Range("a2:a" & z).SpecialCells(xlCellTypeBlanks).Value = "合计"
            a = Range("a65536").End(xlUp).Row + 1
        For b = 2 To a
            If Cells(b, 1) = "合计" Then
                Cells(b, 3) = Application.WorksheetFunction.Sum(Range(Cells(c + 1, 3), Cells(b - 1, 3)))
                Cells(b, 4) = Application.WorksheetFunction.Sum(Range(Cells(c + 1, 4), Cells(b - 1, 4)))
                c = b
             End If
        Next b
    End Sub


Private Sub CommandButton2_Click()
Range("c1:c" & Range("c65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Offset(, 2) = 1
End Sub

Private Sub CommandButton3_Click()
    Range("b1:b" & Range("b65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("a2:a" & Range("a65536").End(xlUp).Row).Offset(, 4).ClearContents
End Sub

评分

参与人数 1金币 +8 收起 理由
兰色幻想 + 8 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-29 08:29 | 显示全部楼层
B06-liuho1
1、
Private Sub CommandButton1_Click()
    Dim x As Integer, n As Integer, m As Integer, a As Integer
    x = 1
    a = 2
    Do
      x = x + 1
      m = Month(Range("A" & x))
        If n = 0 Then
            n = m
        ElseIf m <> n Then
            Rows(x).Insert
            Range("A" & x) = "小计"
            Range("C" & x) = Application.WorksheetFunction.Sum(Range("C" & a & ":C" & x - 1))
            Range("D" & x) = Application.WorksheetFunction.Sum(Range("D" & a & ":D" & x - 1))
            n = m
            a = x + 1
        End If
     Loop Until Range("A" & x) = 0
End Sub
2、

Private Sub CommandButton2_Click()
    Dim ra As Integer
    ra = Range("A65536").End(xlUp).Row
    Range("C2:C" & ra).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Offset(0, 2).Select
    Selection.Cells = 1
End Sub
3、
Private Sub CommandButton3_Click()
    Dim ra As Integer
    ra = Range("A65536").End(xlUp).Row
    Range("B2:B" & ra).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("E2:E" & ra).Select
    Selection.ClearContents
End Sub

第11课作业题-B06-liuho1.rar

22.34 KB, 下载次数: 4

评分

参与人数 1金币 +7 收起 理由
兰色幻想 + 7 答案正确,不过不够简捷

查看全部评分

回复

使用道具 举报

发表于 2012-3-29 11:15 | 显示全部楼层
Private Sub CommandButton1_Click()
Dim i As Integer
    Dim s As Integer
    Dim s1 As Integer
    For i = Range("a65536").End(xlUp).Row + 1 To 3 Step -1
        If Month(Range("a" & i)) <> Month(Range("a" & i - 1)) Then
            Rows(i).Insert
            Cells(i, 1) = "小计"
        End If
    Next
    For i = 2 To Range("a65536").End(xlUp).Row
        If Cells(i, 1) <> "小计" Then
            s = s + Cells(i, 3)
            s1 = s1 + Cells(i, 4)
        Else
            Cells(i, 3) = s
            Cells(i, 4) = s1
            s = 0
            s1 = 0
        End If
    Next i
End Sub

Private Sub CommandButton2_Click()
   Range("D2:D20").Select
    Selection.SpecialCells(xlCellTypeBlanks).Offset(0, 1) = 1
End Sub
Private Sub CommandButton3_Click()
Range("b2:b20").Select
    Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("e2:e20") = ""
End Sub

评分

参与人数 1金币 +8 收起 理由
兰色幻想 + 8 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-29 11:25 | 显示全部楼层
注明自己的新组编号:旧组是13组。申请过2群,未收到回复通过通知
论坛ID:zhouyunj


Sub 按月小计()
Dim i As Integer, n As Integer
For i = 2 To 25 Step 1
n = i
i = i + 1
If Mid(Range("a" & i).Value, 6, 2) = Mid(Range("a" & i - 1).Value, 6, 2) And Cells(i, 1) <> "" Then
    Do While Mid(Range("a" & i).Value, 6, 2) = Mid(Range("a" & i - 1).Value, 6, 2) And Cells(i, 1) <> ""
        i = i + 1
    Loop
    Rows(i).Insert
    Cells(i, 1) = "小计"
    Cells(i, 3) = Application.WorksheetFunction.Sum(Range(Cells(n, 3), Cells(i, 3)))
    'n = i + 1
End If
Next i
End Sub


Sub 发出标志()

    rownum = Range("b65536").End(xlUp).Row
    Range(Cells(2, 3), Cells(rownum, 3)).SpecialCells(xlCellTypeBlanks).Offset(0, 2).Value = 1
   
End Sub



Sub 删除小计及发出标志()
If Range("a65536").End(xlUp).Value = "小计" Then
    Range("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
    Range("e2:e65536").ClearContents
End Sub





评分

参与人数 1金币 +7 收起 理由
兰色幻想 + 7 答案正确

查看全部评分

回复

使用道具 举报

发表于 2012-3-29 15:24 | 显示全部楼层
a组学委:qushui
  1. rivate Sub CommandButton1_Click()
  2.     Dim i%, a%, b%, c%, rg1 As Range, rg2 As Range, rg As Range
  3.     For i = [a65536].End(3).Row To 3 Step -1
  4.         If Month(Cells(i, 1)) <> Month(Cells(i - 1, 1)) Then Rows(i).Insert
  5.     Next i
  6.     Set rg1 = Range([a2], [a65536].End(3)).SpecialCells(xlCellTypeBlanks)
  7.     Set rg2 = Union(rg1, [a65536].End(3).Offset(1, 0))
  8.     rg2.Value = "小计"
  9.     For Each rg In rg2
  10.         b = rg.Row
  11.         If a = 0 Then
  12.             a = 1
  13.             Cells(b, 3) = Application.Sum(Range(Cells(2, 3), Cells(b - 1, 3)).Value)
  14.             Cells(b, 4) = Application.Sum(Range(Cells(2, 4), Cells(b - 1, 4)).Value)
  15.         Else
  16.             Cells(b, 3) = Application.Sum(Range(Cells(c + 1, 3), Cells(b - 1, 3)).Value)
  17.             Cells(b, 4) = Application.Sum(Range(Cells(c + 1, 4), Cells(b - 1, 4)).Value)
  18.         End If
  19.         c = rg.Row
  20.     Next rg
  21. End Sub

  22. Private Sub CommandButton2_Click()
  23.     Range([c1], [a65536].End(3).Offset(0, 2)).SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
  24. End Sub
  25. Private Sub CommandButton3_Click()
  26.     Range([a2], [a65536].End(xlUp)).Offset(0, 4) = ""
  27.     Range("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  28. End Sub
复制代码

第11课作业题.zip

22.7 KB, 下载次数: 3

评分

参与人数 1金币 +7 收起 理由
兰色幻想 + 7 答案正确

查看全部评分

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 00:11 , Processed in 0.596364 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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