VB 按月统计excel 数据

原始数据如下表：
Modified
3/20/2009 4:47
8/18/2009 8:15
3/3/2011 14:24
11/26/2009 5:58
7/6/2010 2:45
3/23/2010 7:55
3/23/2010 7:57
3/23/2010 8:00
4/9/2010 2:52
4/23/2010 1:49
4/23/2010 1:48
4/16/2010 5:36
4/23/2010 1:46
4/23/2010 1:46
5/11/2010 6:44
7/6/2010 2:32
7/6/2010 2:14
7/6/2010 2:30
7/6/2010 8:51
7/29/2010 7:09
7/29/2010 7:08
7/29/2010 7:07
9/2/2010 6:44
9/2/2010 3:39
3/24/2011 14:18
3/24/2011 14:18
11/2/2010 3:15
11/2/2010 3:16
3/24/2011 14:19
3/24/2011 14:19
12/21/2010 6:37
2/10/2011 17:46
12/9/2010 2:58
12/23/2010 2:20
1/20/2011 2:37

预想结果表：
Month Case_No
Oct-09 2
Nov-09 8
Dec-09 2
Mar-10 3
Apr-10 6
May-10 1
Jul-10 13
Aug-10 3
Sep-10 3
Nov-10 4
Dec-10 3
Jan-11 4
Feb-11 3
Mar-11 10
Apr-11 8
May-11 7

用VB处理，把新生成的表放到另外一个新建的表中。 高手赐教 。。。

原始数据为时间列表，只需要统计出每个月的个数即可。

Private Sub Command1_Click()
Dim ExlApp As Excel.Application
Dim ExlBook As Excel.Workbook
Dim ExlBook2 As Excel.Workbook
Dim ExlSheet As Excel.Worksheet
Dim ExlSheet2 As Excel.Worksheet
On Error Resume Next
Dim i As Long, j As Integer, bln1 As Boolean
Set ExlApp = GetObject("Excel.Application")
If Err.Number <> 0 Then
Set ExlApp = CreateObject("Excel.Application")
End If
ExlApp.Visible = True
On Error GoTo 0
Set ExlBook = ExlApp.Workbooks.Open("d:\shuju.xls") '假设原始数据在d:\shuju.xls第一个表中
Set ExlSheet = ExlBook.Worksheets(1)
ExlSheet.Select

Set ExlBook2 = ExlApp.Workbooks.Add
Set ExlSheet2 = ExlBook2.Worksheets(1)
ExlSheet2.Cells(1, 1) = "Month"
ExlSheet2.Cells(1, 2) = "Case_No"

For i = 1 To 60000
If ExlSheet.Cells(i, 1) = "" Then
Exit For
Else
If IsDate(ExlSheet.Cells(i, 1)) Then
j = 2
bln1 = True
Do While (ExlSheet2.Cells(j, 1) <> "")
If ExlSheet2.Cells(j, 1).Value = Format(ExlSheet.Cells(i, 1).Value, "mmm yy") Then
ExlSheet2.Cells(j, 2) = Val(ExlSheet2.Cells(j, 2)) + 1
bln1 = False
Exit Do
End If
j = j + 1
Loop
If bln1 Then '新的月份
ExlSheet2.Cells(j, 1).Value = "'" & Format(ExlSheet.Cells(i, 1), "mmm yy")
ExlSheet2.Cells(j, 2) = Val(ExlSheet2.Cells(j, 2)) + 1
End If
End If
End If
Next i
Set ExlSheet = Nothing
Set ExlSheet2 = Nothing
Set ExlBook = Nothing
Set ExlBook2 = Nothing
Set ExlApp = Nothing

请在www.excelhome.net论坛上索取该 零钞程序～或者qq:28213938索取