エクセルで集計方法

質問

下記のようなエクセルでカウントしたいのですがどのようにしたらいいのか教えてください。

集計条件：
　　(1)年齢（範囲）ごとの習いごとの人数を求めたい
　　(2)年齢の範囲は０歳～９歳，１０歳～１９歳，２０歳～２９歳・・

＜エクセル＞
　　　　A　　　　B　　
1　　 ８歳　　水泳　
2　　１１歳　　ピアノ
3　　　４歳　　英語教室
4　　　６歳　　水泳
5　　２２歳　　ピアノ
6　　２８歳　　ヨガ

※　結果は　下記のようにするのが希望です。

　　０歳～　９歳　水泳　　　　２名
　　０歳～　９歳　英語教室　　１名
　１０歳～１９歳　ピアノ　　　１名
　２０歳～２９歳　ピアノ　　　１名　
　２０歳～２９歳　ヨガ　　　　１名

回答No.3

pkh4989

No1 です。

年齢の半角入力が難しいなら、以下のFinctionを入れ替えて
試してみてください。

Function Get_Index(aGe As Integer) As Integer
　　Get_Index = Fix(aGe / 10) + 1
End Function
↓
'「１１歳のように」 文字列の場合
Function Get_Index(aGe As String) As Integer
　　aGe = Left(aGe, Len(aGe) - 1)
　　aGe = StrConv(aGe, vbNarrow)
　　Get_Index = Fix(Int(aGe) / 10) + 1
End Function

回答No.2

kigoshi

ピボットテーブルで、かなり近い結果が得られると思います。

まず、年齢は数字のみ、つまり「歳」が入っていないようにして下さい。
・すでに「歳」がついている場合は　=VALUE(LEFT(A1,LEN(A1)-1))　などで数値化できます。・数字データにしても「歳」を表示したい場合は[書式]→[ユーザ定義]で　0"歳"

元データの１行目に項目名「年齢」「趣味」をつけ、範囲選択後、
[データ]→[ピボットテーブルとピボットグラフレポート]→[次へ]→[次へ]→[完了]
でピボットテーブルの枠が表示されると思いますのでフィールドリストから「年齢」を「ここに行のフィールドをドラッグします」のエリアにドラッグ＆ドロップします。
続いて「趣味」を同じエリアの右端にドラッグ＆ドロップします。
さらに「趣味」を「ここにデータアイテムをドラッグします」のエリアにドラッグ＆ドロップします。
ピボットテーブルの左上のグレーの部分［年齢▼］のところで右クリック
[グループと詳細の表示]→[グループ化]で、先頭の値：0　末尾の値：年齢の最高値　単位：10をいれて［ＯＫ］で完成するかと思います。

ご参考になれば。

回答No.1

pkh4989

こんにちは。

以下のマクロで、試してみてください。
但し、A列の年齢は以下のように、必ず半角の数字のみ入力してください。
展開は「E列～」にされます。

例)
A列 B列
8　　水泳
11 ピアノ
4　　英語教室
6　　水泳
22 ピアノ
28 ヨガ

Type tLesson
　　NM　　　　　　 As String
　　CNT(10)　　　　 As Integer
End Type
Dim Lesson()　　　　As tLesson
Dim LessonCnt　　 As Integer
Dim tAge　　　　　　As Variant
'
Sub 集計()
　　Dim wR　　 As Long
　　Dim ckNm　　As String
　　Dim wI　　 As Integer
　　Dim xI　　 As Integer
　　Dim c　　 As Range
　　'
　　Application.ScreenUpdating = False
　　tAge = Array("０歳～９歳", "１０歳～１９歳", "２０歳～２９歳", "３０歳～３９歳", "４０歳～４９歳", "５０歳～５９歳", "６０歳～６９歳", "７０歳～７９歳", "８０歳～８９歳", "９０歳～９９歳")
　　Erase Lesson
　　ckNm = "": LessonCnt = 0
　　With ActiveSheet
　　　　wR = .Range("A" & Rows.Count).End(xlUp).Row
　　　　'LESSON順ソート
　　　　.Range("A1:B" & wR).Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("A1"), Order2:=xlAscending
　　　　For Each c In .Range("B1:B" & wR)
　　　　　　If ckNm <> c.Value Then
　　　　　　　　ckNm = c.Value
　　　　　　　　LessonCnt = LessonCnt + 1
　　　　　　　　ReDim Preserve Lesson(LessonCnt)
　　　　　　　　'
　　　　　　　　Lesson(LessonCnt).NM = c.Value
　　　　　　　　wI = Get_Index(.Cells(c.Row, 1))
　　　　　　　　Lesson(LessonCnt).CNT(wI) = Lesson(LessonCnt).CNT(wI) + 1
　　　　　　Else
　　　　　　　　wI = Get_Index(.Cells(c.Row, 1))
　　　　　　　　Lesson(LessonCnt).CNT(wI) = Lesson(LessonCnt).CNT(wI) + 1
　　　　　　End If
　　　　Next
　　　　'
　　　　'表示
　　　　wR = 0
　　　　For wI = 1 To LessonCnt
　　　　　　For xI = 1 To 10
　　　　　　　　If Lesson(wI).CNT(xI) > 0 Then
　　　　　　　　　　wR = wR + 1
　　　　　　　　　　.Cells(wR, 5) = tAge(xI - 1)
　　　　　　　　　　.Cells(wR, 6) = Lesson(wI).NM
　　　　　　　　　　.Cells(wR, 7) = Lesson(wI).CNT(xI) & "名"
　　　　　　　　End If
　　　　　　Next
　　　　Next
　　　　'歳順ソート
　　　　.Range("E1:G" & wR).Sort Key1:=Range("E1"), Order1:=xlAscending, Key2:=Range("F1"), Order2:=xlAscending
　　End With
　　Application.ScreenUpdating = True
End Sub

Function Get_Index(aGe As Integer) As Integer
　　Get_Index = Fix(aGe / 10) + 1
End Function

マクロ貼付
(1) Alt+F11 (ツール → マクロ → Visual Basic Editor) →「挿入」→「標準モジュール」で表示される画面に貼り付け
(2) 実行は、(F5を押す)又は、シート画面に戻って Alt＋F8を押してマクロ一覧からマクロ名を選択して実行