ベストアンサー選定ルールの変更のお知らせ

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

解決済

  • 質問者：momo_2123
  • 質問日時：
  • 回答数：6件

以前、年齢が縦に並んだ表へ別シートからデータをカウントしたマクロをご教授いただきました。
今回、年齢が横に並んだ「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

「別シートから年齢別の件数をカウントしたい」の質問画像

質問者からの補足コメント

  • お考えいただきありがとうございます。途中まで変更しようとしましたが私のスキル不足ですいません。
    10才 52才は不明でカウントしたいです。

      補足日時：2023/01/23 13:57
    通報する

  • tatsumaru77さん　ありがとうございます。
    アップした画像のレイアウトで無事転記できました。
    しかし画像のレイアウトは私のスキル不足を補うため、ご教示いただく内容を理解するため単純化しています。勉強のため実際のレイアウトにあてはめコードを書き換えてみたところ、やはり正常には転記できませんでした。エラーは出ないのですがカウントした値を目視で確認したところ、相違していました。
    単純化するため、マクロ実行前に省いていた抽出条件が2点あり、これが原因でしょうか。
    _マクロ実行前に抽出した条件として
    ①状況シートB列の月「12月」で抽出、
    ②状況シートS列の条件１「あ」で抽出、この2点を手動で抽出後、下記マクロを実行しました。
    この条件で修正箇所がどこなのか教えていただけませんでしょうか。お願いいたします。

      補足日時：2023/01/23 23:38
    通報する

  • Public Sub 年齢別カウント_横()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim maxrow1 As Long 'B列最終行
    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表")

      補足日時：2023/01/23 23:41
    通報する

  • sh2.Range("G15:M18").ClearContents 'B表の値をクリア
    maxrow1 = sh1.Cells(Rows.Count, "B").End(xlUp).Row '状況B列最終行

    For row1 = 3 To maxrow1 '状況3行目～最終行まで
    bun = sh1.Cells(row1, "U").Value '状況シートのC列分類１を選択
    idx = GetBunrui(bun) '分類を取得
    If idx < 0 Then
    MsgBox ("分類1不正")
    sh1.Select
    sh1.Cells(row1, "U").Select '状況の分類列U

      補足日時：2023/01/23 23:44
    通報する

  • Exit Sub
    End If

    row2 = idx + 15 'B表 分類1毎の行番号
    idx = GetAge(sh1.Cells(row1, "K").Value) '状況の年齢列K
    col2 = idx + 8 'B表 年齢毎の列番号
    sh2.Cells(row2, col2).Value = sh2.Cells(row2, col2).Value + 1
    Next
    For row2 = 15 To 25 'B表の分類C列の最初の行から最後の行　15To25
    rgs = "H" & row2 & ":M" & row2 'B表の最初の年齢列H、最後の年齢列M

      補足日時：2023/01/23 23:46
    通報する

  • sh2.Cells(row2, "G").Formula = "=sum(" & rgs & ")" 'B表の計列G
    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", "E", "F", "G", "H", "I", "J", " K")
    For i = 0 To UBound(buns)
    If bun = buns(i) Then
    GetBunrui = i
    Exit Function

      補足日時：2023/01/23 23:47
    通報する

  • 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(15, 20, 25, 30, 35, 40)
    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

      補足日時：2023/01/23 23:49
    通報する

  • 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

      補足日時：2023/01/23 23:49
    通報する

  • 補足画像が添付できないので再度質問にてアップさせていただきます。

      補足日時：2023/01/24 00:12
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (6件)

No.4ベストアンサー

下記にアップしました。


https://ideone.com/oIsDaZ
    • good
    • 0
    • 件
通報する
この回答へのお礼

ご教授いただいたコードで無事転記できました。
別の問題に直面していますので質問しなおしています。
引き続きよろしくお願いいたします。

通報する
お礼日時：2023/01/24 00:20

No.6

※この回答は、“締め切られた質問への回答追加”として、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

初級レベルなジジィなので、だいぶ古いやり方です。
    • good
    • 0
    • 件
通報する

No.5

Ｅ列の行数を 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関数に利用するなり。

値が数値以外が入っているとかの判定が必要なら、既に出来てますしね。
    • good
    • 1
    • 件
通報する
この回答へのお礼

ありがとうございます。勉強してみます。

通報する
お礼日時：2023/01/24 00:21

No.3

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



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

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

参考程度に

No.2

  • 回答者： fujillin
  • 回答日時：

こんにちは



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

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

No.1

年齢が


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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

このQ&Aを見た人はこんなQ&Aも見ています

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

ページトップページトップ

Q質問する（無料）

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング

おすすめ情報