EXCEL 年月日表から月数をカウントする方法

質問

A1セルからB30セル範囲内に重複を含む年月日の値があります。

範囲内のデータから、各月毎に集計したいのです。

例：G列1には、4月は8件、G列2には、5月は6件、G列3には・・・・、

ただし、重複する月日を１としてカウントしたい。

宜しくお願いします。

回答No.2

noname#192382

前にお知らせしたマクロをサブルーチンとして使い、次のマクロ3を一つ動かすだけで全ての作業が1回で出来ます。もし関心がおありでしたら、詳細をお知らせします。
Option Explicit

Sub Macro3()
'
' Macro3 Macro
' マクロ記録日 : 2012/5/8 ユーザー名 :
'
Macro9
Macro4
Macro1
Macro5
Macro10
Macro8
Macro2
Macro11

'
End Sub
Sub Macro11()
'
' Macro11 Macro
' マクロ記録日 : 2012/5/8 ユーザー名 :
'

'
Columns("C:C").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="99"
End Sub

回答No.1

noname#192382

疑問点はデータは同一年か複数年にわたるかですが、一応複数年としてやってみました。
8つのステップで8つのマクロで最終データが得られます。ここでは作業の概要だけ記します。
もとのdataはシート1のa1からb30の範囲にあるものとします。
1全データをしーと2にコピーして、B1からB30を切り取りA31からA60にはりつけする。マクロ9
2シート2第1列のデータを並べ替え　マクロ4
3重複データがあるか調べて、重複しているデータを空欄にして第2列に示し、第3列には空欄をなくしたものを示す。マクロ1
4シート2の第3列をコピーしてしーと3に貼り付ける。マクロ5
5シート3の第2列に月名を抽出する。マクロ8
6シート3第2列を月の順に並べ替え　マクロ8
7シート3のコピーシート(シート3(2))で月別に頻度を調べる　マクロ2
8シート3(2)で月別の頻度を示す　マクロ6
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2012/5/5 ユーザー名 :
'
Dim mygyo As Integer, ckdata As Variant, ckgyo As Integer, newgyo As Integer

Cells(1, 2) = Cells(1, 1)
For mygyo = 2 To 60
ckgyo = mygyo - 1
ckdata = Cells(ckgyo, 1)
If Cells(mygyo, 1) <> ckdata Then
Cells(mygyo, 2) = Cells(mygyo, 1)

End If
'Cells(mygyo, 2) = ckdata
'Cells(mygyo, 2) = Cells(mygyo, 1)
Next
newgyo = 1

For mygyo = 1 To 60

If Cells(mygyo, 2) <> "" Then
Cells(newgyo, 3) = Cells(mygyo, 2)
newgyo = newgyo + 1
Else
newgyo = newgyo
End If

'Cells(mygyo, 2) = ckdata
'Cells(mygyo, 2) = Cells(mygyo, 1)
Next
'
End Sub
Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2012/5/5 ユーザー名 :
'
Dim mygyo As Integer, ckgyo As Integer
Cells(1, 2) = 1
ckgyo = 1
For mygyo = 2 To 59
ckgyo = mygyo - 1
If Cells(mygyo, 1) = Cells(ckgyo, 1) Then
Cells(mygyo, 2) = Cells(ckgyo, 2) + 1
Else
Cells(mygyo, 2) = 1
Cells(ckgyo, 3) = 99
End If

Next
ckgyo = mygyo - 1
Cells(ckgyo, 3) = 99
'
End Sub
Sub Macro4()
'
' Macro4 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
Sub Macro5()
'
' Macro5 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Range("C1:C59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet3").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
Sub Macro8()
'
' Macro8 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Range("B1:B59").Select
Selection.Copy
Sheets("Sheet3 (2)").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
End Sub
Sub Macro6()
'
' Macro6 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="99"
End Sub
Sub Macro9()
'
' Macro9 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Range("A1:B30").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste
Range("B1:B30").Select
Application.CutCopyMode = False
Selection.Cut
Range("A31").Select
ActiveSheet.Paste
End Sub
Sub Macro10()
'
' Macro10 Macro
' マクロ記録日 : 2012/5/7 ユーザー名 :
'

'
Range("B1").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-1])"
Range("B1").Select
Selection.Copy
Range("B2:B59").Select
ActiveSheet.Paste
End Sub

お礼

ご回答有難うございました。
マクロのほかに関数での方法はあるのでしょうか。

補足

ご回答有難うございました。
マクロのほかに関数での方法はあるのでしょうか。