统计VBA学习小组正式组的积分帖之作业上交贴（第14周）

亦铭

Private Sub CommandButton1_Click()
Dim i, k As Integer
k = 2
For i = 3 To 50
If Month(Range("a" & i)) <> Month(Range("A" & i - 1)) Then
Rows(i).Insert
Range("a" & i) = "小计"
Range("c" & i) = "=sum(c" & k & ":c" & i - 1 & ")"
Range("d" & i) = "=sum(d" & k & ":d" & i - 1 & ")"
i = i + 1
k = i
End If
Next i
End Sub

Private Sub CommandButton2_Click()
Range("a2", Range("a65536").End(xlUp)).Offset(0, 3).SpecialCells(xlCellTypeBlanks).Offset(0, 1) = 1
End Sub
Private Sub CommandButton3_Click()
Columns("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("e2:" & Range("e65536").End(xlUp).Address).ClearContents
End Sub

ybchxj2010

1. Private Sub CommandButton1_Click()
   
2. Dim i, r, V As Integer
   
3.    
   
4.     i = [a65536].End(xlUp).Row
   
5.     r = 2
   
6.     V = r
   
7. Do
   
8.     r = r + 1
   
9.     If Month(Cells(r, 1)) > Month(Cells(r - 1, 1)) Then
   
10.         Rows(r).Insert
    
11.         Cells(r, 1) = "小计"
    
12.         Cells(r, 3).Formula = "=SUM(C" & V & ":C" & r - 1 & ")"
    
13.         Cells(r, 4).Formula = "=SUM(D" & V & ":D" & r - 1 & ")"
    
14.         V = r + 1
    
15.         r = r + 2
    
16.     End If
    
17. Loop Until Cells(r, 1) = 0
    
18. 
    
19. Range("a1").CurrentRegion.Value = Range("a1").CurrentRegion.Value
    
20. End Sub
    
21. 
    
22. Private Sub CommandButton2_Click()
    
23. Dim r As Integer
    
24.     r = [a65536].End(xlUp).Row
    
25. 
    
26.     With Range("D2:D" & r)
    
27.     .Replace "0", ""
    
28.     .Copy
    
29.     End With
    
30.     Range("e2").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply
    
31.     Selection.Replace "0", "1"
    
32. End Sub
    
33. Private Sub CommandButton3_Click()
    
34. Dim d, arr
    
35. Dim r As Integer
    
36. 
    
37. If Application.CountIf(Range("A:A"), "小计") Then
    
38. arr = Range("a1").CurrentRegion
    
39. 
    
40. Set d = CreateObject("Scripting.Dictionary")
    
41. 
    
42. For r = 1 To UBound(arr)
    
43.     If arr(r, 1) = "小计" Then
    
44.         d(arr(r, 1) & r) = r & ":" & r
    
45.     End If
    
46. Next
    
47. 
    
48. Range(Join(d.items, ",")).Delete
    
49. Range("e2:e" & UBound(arr)).ClearContents
    
50. End If
    
51. 
    
52. End Sub
    
53. 
    

复制代码

这几天工作太忙，一直没时间上传作业，希望老师能批阅一下？

zhouyunj

zhouyunj 发表于 2012-3-29 11:25
注明自己的新组编号：旧组是13组。申请过2群，未收到回复通过通知
论坛ID：zhouyunj

---

最新分组更新：C20:zhouyunj

szczm121

g17:szczm121
Dim c As Integer, z As Integer, m As Integer, m1 As Integer
Sub 插入小计行()
    z = Range("A65536").End(xlUp).Row
    For c = 2 To z
        If Range("a" & c) <> "" Then
            If Month(Range("a" & c + 1)) <> Month(Range("a" & c)) Then
                Rows(c + 1).Insert
            End If
        End If
    Next c
    z = Range("A65536").End(xlUp).Row + 1
    Range("A2:A" & z).SpecialCells(xlCellTypeBlanks) = "小计"
    m1 = 2
    For m = 2 To z
        If Range("a" & m) = "小计" Then
            Range("b" & m).Offset(0, 1) = Application.Sum(Range("c" & m1 & ":c" & m - 1))
            Range("b" & m).Offset(0, 2) = Application.Sum(Range("d" & m1 & ":d" & m - 1))
            m1 = m + 1
        End If
    Next m
End Sub
Sub 填写标识()
z = Range("c65536").End(xlUp).Row
Range("c2:c" & z).SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
End Sub
Sub 删除小计行()
Range("e:e").ClearContents
Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
第11课作业题（szczm121）.rar (16.36 KB, 下载次数: 3)

2012-4-9 14:09 上传

点击文件名下载附件

ls

游客，如果您要查看本帖隐藏内容请回复

Option Explicit

Private Sub CommandButton1_Click()
    Dim i As Integer, j As Integer
    For i = Range("a65536").End(xlUp).Row To 2 Step -1
        If Month(Range("a" & i)) <> Month(Range("a" & i + 1)) Then
            Range("a" & i + 1).EntireRow.Insert
            Range("a" & i + 1) = "小计"
        End If
    Next i
    j = 2
    For i = 2 To Range("a65536").End(xlUp).Row
        If Range("A" & i) = "小计" Then
            Range("c" & i) = Application.Sum(Range(Range("c" & j), Range("c" & i - 1)))
            Range("d" & i) = Application.Sum(Range(Range("c" & j), Range("c" & i - 1)))
            j = i + 1
        End If
    Next i
End Sub

Private Sub CommandButton2_Click()
    Range("c2:c" & [c65536].End(3).Row).SpecialCells(xlCellTypeBlanks).Offset(, 2) = 1
End Sub
Private Sub CommandButton3_Click()
    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("e2:e" & [e65536].End(3).Row).ClearContents
End Sub

zjyxp

作业重做

1. Private Sub CommandButton1_Click()
   
2.     Dim 入库合计, 发出合计, x
   
3.     For x = 2 To Range("a65536").End(xlUp).Row + 12
   
4.         If Cells(x, 1) = "" Then Exit Sub
   
5.             入库合计 = 入库合计 + Cells(x, 4)
   
6.             发出合计 = 发出合计 + Cells(x, 3)
   
7.         If Month(Cells(x, 1)) <> Month(Cells(x + 1, 1)) Then
   
8.             Rows(x + 1).Insert
   
9.             x = x + 1
   
10.               Cells(x, 1) = "小计"
    
11.               Cells(x, 3) = 发出合计
    
12.               Cells(x, 4) = 入库合计
    
13.               发出合计 = 0
    
14.               入库合计 = 0
    
15.         End If
    
16.     Next x
    
17. End Sub
    
18. Private Sub CommandButton2_Click()
    
19.     Range("c2:C" & Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
    
20. End Sub
    
21. Private Sub CommandButton3_Click()
    
22.     Range("b2:b" & Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
23.     Range("e2:e" & Range("a65536").End(xlUp).Row) = ""
    
24. End Sub
    

复制代码

laoau126

5626663