
いつもお世話になっております
シート1からシート9まであり
シート名は
4月 5月 6月 7月 8月 9月
です。
それに加えてシート名 集計があります。
添付ファイルのように
各々の月の件数だけを知りたいのです。
注意 例)4月に5月の月が混ざっている場合があります。
各月の月末になると次月の件数がある場合が
あります。
Dictionary で行うと
keyを月にすると 書き出すときに
4月 5月 6月 7月 8月 9月
4月 20
5月 15
6月 25
7月 18
8月 26
9月 25
になってしまいます。
4月 5月 6月 7月 8月 9月
件数 20 15 25 18 26 25
としたいのです。
わかる方おしえてくれませんでしょうか

No.6ベストアンサー
- 回答日時:
こんばんは
なんだかとても複雑なことをなさっていますけれど、やりたいことは、
「各シートの誕生日(=F列)から、月別に人数(件数なのかな?)の集計をしたい」
ってことではないかと勝手に解釈しました。
月は1~12と決まっているので、連想配列の必要もないと思います。
(ご提示の図では、なんで4~9月だけなのか、よくわかりませんけれど・・・)
>わかる方おしえてくれませんでしょうか
うまくいかないコードを示す前に、なさりたいことをきちんと説明しておいた方が宜しいかと思いますよ。
上記の解釈で良いものとして・・
・シートはシートNoでループして良いものとして、とりあえず
1~3にしてあります。
・実データは各シートの3行目以降にあるものと仮定しています。
・集計結果は配列 T に入りますが、T(1)が1月の人数・・という具合です。
・仮として、「集計」シートのC3:N3に1~12月の人数を結果として入れて
ありますが、実際には必要な月だけを使用すれば良いでしょう。
(図の2行目の表題とは、ずれますけれど悪しからず)
Sub sample()
Dim T(1 To 12), v, m
Dim shtNo As Long
Dim i As Long, n As Long
Const shtName = "集計"
For shtNo = 1 To 3
With Worksheets(shtNo)
If .Name <> shtName Then
n = Application.Max(.Cells(Rows.Count, 6).End(xlUp).Row - 2, 1)
v = .Cells(3, 6).Resize(n).Value
For i = 1 To n
m = v(i, 1)
If IsDate(m) Then T(Month(m)) = T(Month(m)) + 1
Next i
End If
End With
Next shtNo
Worksheets(shtName).Range("C3:N3").Value = T
End Sub
No.9
- 回答日時:
こんばんは
ご質問の回答にはなりませんが、やっぱり細切れで良く分かりません。
表示画像の表組で生年月日が各シートF列3行目から下にばらばらに入っている時の同月カウント集計処理を書いた方が良さそう、、、
(前後の都合もあるかと思いますのでそうはいかないかもです)
すでに代替えコードも回答されていますが、一応。
Sub test()
Dim i As Long, n As Long, cnt As Long
Dim r As Range
Dim aryAns(), aryMonth As Variant
Dim Sh As Worksheet
With Worksheets("集計")
aryMonth = .Range(.Cells(3, 3), .Cells(3, Columns.Count).End(xlToLeft))
End With
ReDim aryAns(UBound(aryMonth, 2))
For i = 1 To UBound(aryMonth, 2)
For Each Sh In Sheets(Array("4月", "5月", "6月", "7月", "8月", "9月"))
With Sh
For Each r In Sh.Range(Sh.Cells(3, "F"), Sh.Cells(Rows.Count, "F").End(xlUp))
If Month(aryMonth(1, i)) = Month(r) Then cnt = cnt + 1
Next
End With
aryAns(n) = cnt
Next
n = n + 1
cnt = 0
Next
Worksheets("集計").Cells(4, 3).Resize(, UBound(aryAns) + 1) = aryAns
End Sub
If Month(aryMonth(1, i)) = Month(r) でなく
同じ年ならcountifsが使えるのだけれど、、
No.8
- 回答日時:
補足日時:2021/12/17 22:42 より。
4月 6
5月 1
6月 1
となります
4月 5月 6月
6 1 1
についてはOffset(行方向, 列方向)の使い方のミスですかね。
2ヶ所ありますが行・列指定が逆になってます。
月は列方向に件数は行方向に書き込みたいのでは?
あとMonthで月の数値をキーにされているのに書き出される際に『月』が付いているのは何故なのかなと。
書式設定でも弄ってます?
---------------
補足と言うより他回答者さまへのお詫びになります。
連想配列になっているのは当初私が回答した内容であり、VB・VC#で扱ってハマった時の物をVBAで使ってみたからだと思います。
なのであまり責めないでください。
その時の質問では『年度』でした。
No.5
- 回答日時:
連投すみません
Set xse = Range("G3") でしたね
なのでここではありませんね。忘れてください。
R.Resize(, dic.Count) = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Key))
まちがっているところおしえてくれませんでしょうか
No.3
- 回答日時:
こんばんは、横から失礼します。
回答ではありませんが、最近、りんごプリン様のご質問を読んで思う事があります。
コード、ロジックを組まれていて ご質問に挙がる内容は、自身で解決できるのでは無いかと思う事が多くあります。
敢えて書きますとロジックやメソッド、オプションなど理解しているのでは無いかと思うのですが、何故躓くのか・・
デバッグのスキルがコード作成のスキルに追い付いていないのでは無いかと思います。
単純に各変数などの現在の値を確認するには Debug.printなどで出来ていると思いますが、配列の内容や型などを確認する作業で良くお判りにならないのでは無いかと思うのです。
コードを書くのは調べながらコピペでも、リファレンスを読んで試すでも
ある程度スキルがあれば難しい事では無い様な気がします。
ただ、デバッグは中々難しいです。色々なケースを想定する、、試す、対策する、などなど・・
言いたい事を纏めます。
ローカルウィンドウは使用していますか?
配列の取得が終了した時点で Stop や ステップ実行などで
各値、配列のインデックス、配列内の値、各変数やオプション、型などをモニターする事が出来ます。
その内容を見れば 多分、どこに間違いがあるのか、どのように代入、取得すれば良いのか、型エラーなども おおよそ見当が付くはずです。
躓いてもご自身で解決できるであろうスキルがあると思いましたので
もう一歩進んで見てはと思います。
参考まで
No.2
- 回答日時:
画像ではDictionaryのキーは『No』になっているようですけど、合っているのでしょうか?
本来は『生年月日?』なのでは?
あとコードは取り込みであって書き出し方法ではないので質問文とは一致しない箇所を提示しているようにも思えます。
件数をカウントするのなら
, Range("H1:AG1").Value
m = IIf(Month(r.Offset(, 1).Value) < 4, _
Month(r.Offset(, 1).Value) + 9, Month(r.Offset(, 1).Value) - 3)
ここが何故存在しているのかも不思議です。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) パワーポイントのエクセルグラフでの月の表示 1 2022/11/19 13:10
- Excel(エクセル) ②Excel 簡単にシートコピーしたら前日の残高と日付を変更させたい→マクロの記録でエラーが出ます 8 2022/07/16 20:40
- Excel(エクセル) エクセルの数式で教えてください。 2 2023/03/10 08:51
- Excel(エクセル) vba シートの並び替え 1 2023/04/19 13:44
- Excel(エクセル) Excel セルに入っている日付を参照して、別シートのリストを表示させたい 1 2022/04/12 17:02
- その他(暮らし・生活・行事) 半年おきの2つの月の組み合わせ 2 2023/07/01 17:22
- 健康保険 随時改定・月変 について教えて下さい。 1 2023/01/15 14:54
- Visual Basic(VBA) 列 A に同じ日が2つが必要です。 1 2023/03/28 07:25
- Excel(エクセル) 何方か知恵をください… 下記のシート1にシート2のDATAを表示させたいです。 (シート1の2行目の 6 2022/03/28 17:27
- 転職 在職中の転職活動について。 4月13日に採用面接を受けた場合、多分結果が出るのが 4月末くらいだと思 4 2022/04/10 00:07
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
XL:BeforeDoubleClickが動かない
-
【ExcelVBA】全シートのセルの...
-
特定の文字を含むシートだけマ...
-
Excel複数シートを別ブックに値...
-
実行時エラー'1004': WorkSheet...
-
実行時エラー1004「Select メソ...
-
ExcelのVBAのマクロで他のシー...
-
Excel チェックボックスにチェ...
-
excel マクロでシート名取得
-
VBAで同じシート名のコピー時は...
-
VBAをMACで使えるようにしたい&...
-
ExcelVBA:複数の特定のグラフ...
-
エクセルのシート名変更で重複...
-
vba findnext で検索し一致した...
-
【Excel VBA】Worksheets().Act...
-
VBA ユーザーフォーム上のチェ...
-
セルのコピーで「オブジェクト...
-
エクセルのマクロについて教え...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelマクロのエラーを解決した...
-
特定の文字を含むシートだけマ...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
excelのマクロで該当処理できな...
-
実行時エラー'1004': WorkSheet...
-
ブック名、シート名を他のモジ...
-
実行時エラー1004「Select メソ...
-
VBA 存在しないシートを選...
-
ExcelVBA:複数の特定のグラフ...
-
エクセルのシート名変更で重複...
-
IFステートの中にWithステート...
-
VBA 検索して一致したセル...
-
ExcelのVBAのマクロで他のシー...
-
XL:BeforeDoubleClickが動かない
-
別のシートから値を取得するとき
-
エクセルVBA Ifでシート名が合...
-
エクセル・マクロ シートの非...
-
シートが保護されている状態で...
-
シート削除のマクロで「delete...
おすすめ情報
日付は5月なので5月に加えるのか?
はい 5月に加えます
コードは文字数の制限でこれだけ載せます。
Set myDic = CreateObject("Scripting.Dictionary")
For Each r In Range("B2", Cells(Rows.Count, "B").End(xlUp))
If Not myDic.Exists(r.Value) Then _
myDic.Add r.Value, Range("H1:AG1").Value
m = IIf(Month(r.Offset(, 1).Value) < 4, _
Month(r.Offset(, 1).Value) + 9, Month(r.Offset(, 1).Value) - 3)
画像ではDictionaryのキーは『No』になっているようですけど、合っているのでしょうか?
本来は『生年月日?』なのでは?
すみませんです。
あとコードは取り込みであって書き出し方法ではないので質問文とは一致しない箇所を提示しているようにも思えます。
件数をカウントするのなら
, Range("H1:AG1").Value
必要かなとおもい。
m = IIf(Month(r.Offset(, 1).Value) < 4, _
Month(r.Offset(, 1).Value) + 9, Month(r.Offset(, 1).Value) - 3)
ここまではできたのです。
For Each w In Array(1, 2)
With Worksheets(w)
For Each R In .Range("B3", .Cells(Rows.Count, "B").End(xlUp))
Key = Month(R.Offset(, 4))
If Not Dic.Exists(Key) Then
Dic.Add Key, Range("H1:R1")
m = IIf(Month(R.Offset(, 4).Value) < 4, _
Month(R.Offset(, 4).Value) + 9, _
Month(R.Offset(, 4).Value) - 3)
v = Dic(Key)
v(1, m) = v(1, m) + 1
Dic(Key) = v
End If
Next
End With
Next
For Each Key In Dic.keys
Range("G3") = Key
Range("H3") = Dic(Key)
Next
Set R = Nothing
Set wf = Nothing
これだと 12 と 表示されるだけです。
さっきまでつくってたのは下記のようにいったのですが、
改良したのが変になり どうにもなりません。
4月 5月 6月 7月 8月 9月
4月 20
5月 15
6月 25
7月 18
8月 26
9月 25
Dim xse As Range
Set xse = Range("G3")
For Each Key In Dic.keys
xse = Key
xse.Offset(, 1).Resize(, 6) = Dic(Key)
Set xse = xse.Offset(1)
Next
これで このようになります
4月 20
5月 15
6月 25
7月 18
8月 26
9月 25
上の形を下記のようにしたいのです。
4月 5月 6月 7月 8月 9月
件数 20 15 25 18 26 25
としたいのです。
だけのこのコード だめです。
きちんと数ひろっていませんです。
ローカルウィンドウは使用していますか?
配列の取得が終了した時点で Stop
は見ています。
ただ、正直 自己解決できるレベル
というものではありません。
Debug.printなどで出来ていると思いますが、
配列の内容や型などを確認する作業で良くお判りにならないのでは無いかと思うのです。
はい、
Debug.print まったく使ってないです。
正直 わかりませんです。
この時はこれしか浮かばないでした。
文字数の制限で2回に分けます。
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, "b").End(xlUp).Row
If Not dic.Exists(Month(Cells(i, "f").Value)) Then
dic.Add Month(Cells(i, "f").Value), 1
Else
dic(Month(Cells(i, "f").Value)) = dic(Month(Cells(i, "f").Value)) + 1
End If
Next
ここまでは良いのですが
Dim R As Range
Set R = Range("H2")
For Each Key In dic.keys
R.Value = Key
R.Offset(, 1) = dic(Key)
Set R = R.Offset(1)
Next
Set dic = Nothing
4月 6
5月 1
6月 1
となります
4月 5月 6月
6 1 1
にしたいのです