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

shengxudong

Option Explicit
Private Sub CommandButton1_Click()
Dim x As Long
Dim yue As Integer
Dim yue1 As Integer
Dim fachu As Double
Dim ruku As Double
x = 2
Do While Cells(x, 1).Value <> ""
    yue = Month(Cells(x, 1).Value)
    fachu = fachu + Cells(x, 3).Value
    ruku = ruku + Cells(x, 4).Value
    If x > 2 Then
         If Cells(x - 1, 1).Value = "小计" Then
             yue1 = yue
         Else
             yue1 = Month(Cells(x - 1, 1).Value)
         End If
         If yue <> yue1 Then
             fachu = fachu - Cells(x, 3).Value
             ruku = ruku - Cells(x, 4).Value
             Rows(x).Insert
             Cells(x, 1).Value = "小计"
             Cells(x, 3).Value = fachu
             Cells(x, 4).Value = ruku
             fachu = 0
             ruku = 0
         End If
    End If
x = x + 1
Loop
Cells(x, 1).Value = "小计"
Cells(x, 3).Value = fachu
Cells(x, 4).Value = ruku
fachu = 0
ruku = 0
End Sub
Private Sub CommandButton2_Click()
Dim brows As Long
    brows = Range("A:A").End(xlDown).Row
    Range("C2:C" & brows).SpecialCells(xlCellTypeBlanks).Offset(0, 2).Select
    Selection.Cells = 1
    Range("A1").Select
End Sub
Private Sub CommandButton3_Click()
Dim brows As Long
    Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    brows = Range("A:A").End(xlDown).Row
    Range("C2:C" & brows).SpecialCells(xlCellTypeBlanks).Offset(0, 2).Select
    Selection.Cells.ClearContents
    Range("A1").Select
End Sub

1982zyh

1. Private Sub CommandButton1_Click()
   
2. 
   
3. Dim m As Integer
   
4. Dim n As Integer
   
5. Dim arr, x
   
6. Dim d
   
7. Dim k1 As Integer
   
8. Dim k2 As Integer
   
9. Dim k As Integer
   
10. Dim mon1
    
11. Dim mon2
    
12. 
    
13. 
    
14. 'Set d = CreateObject("scripting.dictionary")
    
15. 
    
16. m = ActiveSheet.UsedRange.Rows.Count
    
17. 
    
18. arr = Range("a1").CurrentRegion
    
19. '
    
20. 'For x = 2 To UBound(arr)
    
21. '      d(Month(arr(x, 1))) = ""
    
22. 'Next x
    
23. '
    
24. 'm = m + d.Count
    
25. 
    
26. k = 0
    
27. 
    
28. For n = 2 To UBound(arr)
    
29. 
    
30.     mon1 = Month(arr(n, 1))
    
31. 
    
32.     If mon2 <> mon1 Then
    
33.    
    
34.    
    
35.         mon2 = mon1
    
36.         
    
37.         k = k + 1
    
38.         
    
39.     End If
    
40. 
    
41. Next n
    
42. 
    
43. k1 = 2
    
44. 
    
45. For n = 3 To m + k
    
46.    
    
47.     If Cells(n - 1, 1) <> "" Then
    
48.    
    
49.     If Month(Cells(n, 1)) <> Month(Cells(n - 1, 1)) Then
    
50.    
    
51.         Rows(n).Insert
    
52.         
    
53.         k2 = n
    
54.         
    
55.         Cells(k2, 3) = Application.WorksheetFunction.Sum(Range(Cells(k1, 3), Cells(k2 - 1, 3)))
    
56.         
    
57.         Cells(k2, 4) = Application.WorksheetFunction.Sum(Range(Cells(k1, 4), Cells(k2 - 1, 4)))
    
58.         
    
59.         k1 = n + 1
    
60.                            
    
61.     End If
    
62.    
    
63.     End If
    
64. 
    
65. Next n
    
66. 
    
67. 
    
68. Range("a:a").SpecialCells(xlCellTypeBlanks).Value = "小计"
    
69. 
    
70. End Sub
    
71. 
    
72. Private Sub CommandButton2_Click()
    
73. 
    
74. 
    
75. Range("C:C").SpecialCells(xlCellTypeBlanks).Offset(0, 2).Value = 1
    
76. 
    
77. End Sub
    
78. Private Sub CommandButton3_Click()
    
79. 
    
80. Dim mm As Integer
    
81. 
    
82. mm = ActiveSheet.UsedRange.Rows.Count
    
83. 
    
84. 
    
85. Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
86. 
    
87. Range("E2:E" & mm).ClearContents
    
88. 
    
89. End Sub
    

复制代码

xxjjdd0000

A01:xxjjdd0000
Private Sub CommandButton1_Click()
  Dim x As Integer
  Dim ran As Range
    For x = 2 To Sheet1.Range("a65536").End(xlUp).Row
      With Sheet1
        If Month(.Cells(x, 1)) <> Month(.Cells(x + 1, 1)) Then
            y = y + 1
        If y = 1 Then
          Set ran = .Cells(x + 1, 1)
        Else
          Set ran = Union(ran, .Cells(x + 1, 1))
        End If
       End If
      End With
  Next
  ran.EntireRow.Insert
  Range("A2:A" & Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Value = "小计"
  Range("C6,D6,C17,D17").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
  Range("C12,D12").FormulaR1C1 = "=SUM(R[-5]C:R[-1]C)"
  Range("C20,D20").FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
End Sub
Private Sub CommandButton2_Click()
  Range("C2:C" & Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
End Sub
Private Sub CommandButton3_Click()
  Range("B2:B20").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  Range("E2:E20").ClearContents
End Sub

hactnet

H组 hactnet
来交下作业，请老师看看

Private Sub CommandButton1_Click()

'小计例1
Dim x As Integer, k1 As Integer, k2 As Integer
k1 = 2
For x = 2 To 30
    If DateDiff("m", Range("a" & x), Range("a" & x + 1)) Then
        k2 = x
       Rows(x + 1).Insert
       Range("a" & x + 1) = "小计"
        Range("a" & x + 1).Offset(0, 2) = "=sum(c" & k1 & ":c" & k2 & ")"
        Range("a" & x + 1).Offset(0, 2).Resize(1, 2).FillRight
        x = x + 1
        k1 = k2 + 2
    End If
Next x

End Sub


Sub 小计例2()
Dim x As Integer, k1 As Integer, k2 As Integer
k1 = 2
For x = 2 To 30
'For x = 2 To Range("A65536").End(xlUp).Row + 10

'If Range("a" & x) = "" Then Exit Sub

       If DateDiff("m", Range("a" & x), Range("a" & x + 1)) Then
           
        '**************************************************************
        
        'If Month(Cells(x, 1)) <> Month(Cells(x + 1, 1)) Then
   
        'If Year(Cells(x, 1)) = Year(Cells(x + 1, 1)) And Month(Cells(x, 1)) <> Month(Cells(x + 1, 1)) Then
        '
        '**************************************************************
   
       k2 = x
       Rows(x + 1).Insert
   
       Range("a" & x + 1) = "小计"
       Range("a" & x + 1).Offset(0, 2) = Application.Sum(Range(Range("c" & k1), Range("c" & x))) '"=sum(c2:c5)"
       Range("a" & x + 1).Offset(0, 3) = Application.Sum(Range(Range("d" & k1), Range("d" & x))) '"=sum(d2:d5)"
      
       x = x + 1
      
       k1 = k2 + 2
   
        '**************************************************************
        'Else

        'Rows(x + 2).Insert
        '   Range("a" & x + 1) = "小计"
        '   Range("a" & x + 1).Offset(0, 2) = Application.Sum(Range(Range("c" & k), Range("c" & x))) '"=sum(c2:c5)"
        '   x = x + 1
        '   k = x + 1
        '*************************************************************
   
        End If

Next x

End Sub

Private Sub CommandButton2_Click()

Range("c:c").SpecialCells(xlCellTypeBlanks).Offset(0, 2) = "1"

End Sub
Private Sub CommandButton3_Click()

'恢复表格
Range("c:c").SpecialCells(xlCellTypeBlanks).Offset(0, 2) = ""
Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

chrissha

C10: CHRISSHA
C10 CHRISSHA 第11课作业题.rar (14.6 KB, 下载次数: 14)

2012-4-2 23:39 上传

点击文件名下载附件

chrissha

c10:chrissha
网络问题，不知道有没有问题，所以重上传一次
C10 CHRISSHA 第11课作业题.rar (14.6 KB, 下载次数: 2)

2012-4-2 23:42 上传

点击文件名下载附件

wenchduan

A组长：wenchduan

1. Private Sub CommandButton1_Click()
   
2. Dim j, k, m, n
   
3.     k = 2
   
4.     m = 0
   
5.     n = 0
   
6.       For j = 2 To Range("A65536").End(xlUp).Row + k
   
7.          If Range("A" & j) > DateSerial(2012, k + 1, 0) Then
   
8.             Rows(j).Insert
   
9.             Range("A" & j) = "小计"
   
10.             Range("C" & j) = m
    
11.             Range("D" & j) = n
    
12.             m = 0
    
13.             n = 0
    
14.             k = k + 1
    
15.             j = j + 1
    
16.           End If
    
17.           m = Range("C" & j) + m
    
18.           n = Range("D" & j) + n
    
19.      Next j
    
20.      Rows(j + 1).Insert
    
21.      Range("A" & j + 1) = "小计"
    
22.      Range("C" & j + 1) = Range("C" & j) + m
    
23.      Range("D" & j + 1) = Range("D" & j) + n
    
24. End Sub
    
25. Private Sub CommandButton2_Click()
    
26.   Range("C2:C16").SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
    
27. End Sub
    
28. Private Sub CommandButton3_Click()
    
29.   Dim i
    
30.    For i = 2 To Range("A65536").End(xlUp).Row
    
31.      If Range("A" & i) = "小计" Then Range("A" & i).EntireRow.Delete
    
32.      Range("E" & i).ClearContents
    
33.    Next i
    
34. End Sub

复制代码

开心妙妙

B09开心妙妙
最后一个小计不知道怎样实现

Private Sub CommandButton1_Click()
    Dim I As Integer, i1 As Integer, i2 As Integer
    i1 = 2
    For I = 2 To Range("A65536").End(xlUp).Row
        If Cells(I, 1) = "" Then Exit Sub
        If VBA.Month(Range("A" & I)) <> VBA.Month(Range("A" & I + 1)) Then
            i2 = I
            Rows(I + 1).Insert
            Range("A" & I + 1) = "小计"
            Range("C" & I + 1) = "=sum(C" & i1 & ":C" & i2 & ")"
            Range("D" & I + 1) = "=sum(D" & i1 & ":D" & i2 & ")"
            I = I + 1
            i1 = i2 + 2
        End If
    Next I
End Sub

Private Sub CommandButton2_Click()
    Range("C2:C" & Range("C65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Offset(0, 2) = 1
End Sub
Private Sub CommandButton3_Click()
    Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
B09开心妙妙-第11课作业题.rar (27.39 KB, 下载次数: 10)

2012-4-3 16:44 上传

点击文件名下载附件
作业带有宏病毒

水上漂123

第11课作业题.zip (22 Bytes, 下载次数: 7)

2012-4-3 21:44 上传

点击文件名下载附件 Private Sub CommandButton1_Click()
Dim x As Integer, m1 As Integer, m2 As Integer, k As Integer
m1 = 2
For x = 2 To 100
If Month(Cells(x, 1)) <> Month(Cells(x + 1, 1)) Then
m2 = x
Rows(x + 1).Insert
Cells(x + 1, 1) = "小计"
Cells(x + 1, 3) = "=sum(c" & m1 & " :c" & m2 & ")"
Cells(x + 1, 4) = "=sum(d" & m1 & " :d" & m2 & ")"
x = x + 1
m1 = m2 + 2
End If
Next x
End Sub

Private Sub CommandButton2_Click()
Intersect(Range("d:d").SpecialCells(xlCellTypeBlanks).EntireRow, Range("e:e").EntireColumn) = 1
End Sub
Private Sub CommandButton3_Click()
Range("e:e") = ""
Range("b:b").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

zjyxp

作业1

1. Private Sub CommandButton1_Click()
   
2. Dim k As Integer, i As Integer
   
3. Dim m1 As Integer, m2 As Integer
   
4.     m1 = 2
   
5.     For i = 2 To 100
   
6.         If Month(Range("a" & i)) <> Month(Range("a" & i + 1)) Then
   
7.             Rows(i + 1).Insert
   
8.             Range("a" & i + 1) = "小计"
   
9.             m2 = i
   
10.             Cells(i + 1, "c") = "=sum(c" & m1 & ":c" & m2 & ")"
    
11.             Cells(i + 1, "d") = "=sum(d" & m1 & ":d" & m2 & ")"
    
12.                 i = i + 1
    
13.                 m1 = m2 + 2
    
14.             End If
    
15.     Next i
    
16. End Sub

复制代码

作业2，老师我不会

1. Private Sub CommandButton2_Click()
   
2. Dim y As Integer
   
3. For y = 2 To Range("a65536").End(xlUp).Row
   
4. If Cells(y, 3) = "" Then
   
5. Cells(y, 5) = 1
   
6. End If
   
7. Next y
   
8. End Sub

复制代码

作业3

1. Sub 添加发出标志()
   
2. Dim z As Integer, z1 As Integer
   
3. z1 = 1
   
4. z = Range("c" & z1).End(xlDown).Row + 1
   
5. Cells(z, 5) = 1
   
6. z1 = z + 1
   
7. End Sub
   

复制代码

参与学习，请老师多多指导！