別シートから年齢別の件数をカウントしたい

Question

以前、年齢が縦に並んだ表へ別シートからデータをカウントしたマクロをご教授いただきました。
今回、年齢が横に並んだ「B表シート」へ「状況シート」からカウントするため、下記マクロへ変更したのですが表が崩れてしまいできません。どのように修正したらよいか教えてください。

Public Sub 年齢別カウント_横()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow1 As Long '年齢最終行
Dim row1 As Long
Dim row2 As Long
Dim col2 As Long
Dim rgs As String
Dim rgs1 As String
Dim rgs2 As String
Dim idx As Long
Dim bun As String
Set sh1 = Worksheets("状況")
Set sh2 = Worksheets("B表")
sh2.Range("C5:G16").ClearContents '値をクリア
maxrow1 = sh1.Cells(5, 8).End(xlToRight) '年齢最終列まで
For row1 = 8 To maxrow1 '年齢列8行目～最終列まで
bun = sh1.Cells(Rows.Count, "C").Value '状況シートのC列分類１を選択
idx = GetBunrui(bun) '分類を取得
If idx < 0 Then
MsgBox ("分類1不正")
sh1.Select
sh1.Cells(row1, "C").Select
Exit Sub
End If
col2 = idx + 3 '状況シート年齢列
idx = GetAge(sh1.Cells(row1, "E").Value) '年齢を取得
row2 = idx + 5 '
sh2.Cells(row2, col2).Value = sh2.Cells(row2, col2).Value + 1
Next
For col2 = 3 To 6
rgs1 = sh2.Cells(5, col2).Address(False, False)
rgs2 = sh2.Cells(15, col2).Address(False, False)
rgs = rgs1 & ":" & rgs2
sh2.Cells(16, col2).Formula = "=sum(" & rgs & ")"
Next
For row2 = 5 To 16
rgs = "A" & row2 & ":F" & row2
sh2.Cells(row2, "G").Formula = "=sum(" & rgs & ")"
Next
MsgBox ("完了")
End Sub

Private Function GetBunrui(ByVal bun As String) As Long
Dim buns As Variant
Dim i As Long
buns = Array("A", "B", "C", "D")
For i = 0 To UBound(buns)
If bun = buns(i) Then
GetBunrui = i
Exit Function
End If
Next
GetBunrui = -1
End Function

Private Function GetAge(ByVal vage As Variant) As Long
Dim vals As Variant
Dim i As Long
Dim age As Long
vals = Array(0, 20, 25, 30, 35, 40, 999)
GetAge = UBound(vals)
If IsNumeric(vage) = False Then Exit Function
age = Int(vage)
If age < vals(0) Or age >= vals(UBound(vals)) Then Exit Function
For i = 0 To UBound(vals) - 1
If age >= vals(i) And age < vals(i + 1) Then
GetAge = i
Exit Function
End If
Next
End Function

tatsumaru77 · Accepted Answer

下記にアップしました。
https://ideone.com/oIsDaZ

めぐみん_ · Answer

※この回答は、“締め切られた質問への回答追加”として、2023/01/25 12:15 に回答者の方よりご依頼をいただき、教えて!gooによって代理投稿されたものです。

エラー処理（入力されている値の型や書き込むセル範囲の変動など）はしていません。
０の場合は表示しないようにしてます。

Sub 年齢区分別カウント_横()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim r1 As Range
Dim bun_str As String
Dim n As Integer
Dim age_Area As Integer
Dim v(1 To 11, 1 To 6) As Variant

Set ws1 = Worksheets("状況")
Set ws2 = Worksheets("B表")

bun_str = "ABCDEFGHIJK" 'ここに違いがあるとエラーになります。

With ws1
For Each r1 In .Range("K3", .Cells(Rows.Count, "K").End(xlUp)).SpecialCells(xlCellTypeVisible)

n = InStr(bun_str, r1.Range("I1").Value)
age_Area = IIf(r1.Value <= 14 Or r1.Value >= 40, 6, Int((r1.Value - 15) / 5) + 1)

v(n, age_Area) = v(n, age_Area) + 1
Next
End With

With ws2
.Range("G15:M25").ClearContents
.Range("H15").Resize(11, 6).Value = v
.Range("G15:G25").Value = "=SUM(H15:M15)"
.Range("G15:M25").NumberFormatLocal = "G/標準""人"";;" 
End With

End Sub

初級レベルなジジィなので、だいぶ古いやり方です。

めぐみん_ · Answer

Ｅ列の行数を i と言う変数でループさせた時、

age = iif(cells(i, "E").value <= 14 or cells(i, "E").value >= 40, 6  _
, int((cells(i, "E").value - 15) / 5))

でＨ～Ｍ列に対して 0 ~ 5 の数値を得られる。
あとは配列に利用するなりoffset関数に利用するなり。

値が数値以外が入っているとかの判定が必要なら、既に出来てますしね。

めぐみん_ · Answer

既に回答が付いているのかもですが。

年齢をユーザー関数で求めるほど複雑な内容ではないと思います。
どっちかと言えば『５歳刻み』にするって点は中学程度の数学で、年齢の範囲分類は可能ではないかなと。
まぁ、配列のインデックス（0 始まり）に使えるのでは？
先に１４歳以下と４０歳以上は除外する必要はあるでしょうけど。

気になるのは『地域』が他にもあって『１つの表』から各シートにも振り分け作業をするのかな？って所でしょうか。

fujillin · Answer

こんにちは

Countifs関数を用いれば、普通に算出できる内容と思います。

わざわざ「わからないマクロ」などを利用するよりも、今後とも変更に対応できると思いますけれど？

tatsumaru77 · Answer

年齢が
15～19
20～24
25～29
30～34
35～39
不明
となってますが、
10歳、52歳等の場合は、不明としてカウントして良いのでしょうか？

別シートから年齢別の件数をカウントしたい

下記にアップしました。

※この回答は、“締め切られた質問への回答追加”として、2023/01/25 12:15 に回答者の方よりご依頼をいただき、教えて!gooによって代理投稿されたものです。

Ｅ列の行数を i と言う変数でループさせた時、

既に回答が付いているのかもですが。

こんにちは

年齢が

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング