『データレコードからの月別カウント』（POKO）
初めまして。
データのカウントについてご教示ください。
データレコードの列に下記のようなレコードがございます。
氏名 スキル 所要月 終了月
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
TBD S 4月
TBD A 5月
TBD A 5月
TBD S 6月
あ A 4月 5月
あ A 6月
い S 4月 6月
い S 7月 8月
う S 5月 6月
え A 5月 7月
お A 4月 7月
まず一つは、氏名がTBDのレコードに対し、各月の集計値を下記のような
表にまとめたいです。
スキル 4月 5月 6月
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
S 1 0 1
A 0 2 0
もう一つは、氏名がTBD以外のレコードで、終了月がブランク以外で
かつ同じ氏名でブランクのレコードがない方の月別カウントを表にしたいです。
例えば、”あ”さんは終了月の入っているレコードがあるが、終了月の入っていない
レコードもあるので対象外
”い”さんについては6月と8月に終了月が入っているが、より大きい8月だけをカウントしたい
スキル 4月 5月 6月 7月 8月
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
S 0 0 1 0 1
A 0 0 0 2 0
お手数ですが、どうぞよろしくお願いいたします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
Power Queryで出来そうですが、 数式での回答を希望でしょうか。 （マナ） 2025/02/23(日) 06:44:44
おはようございます。 取り敢えず書いてみましたけど、、途中で分からなくなっちゃったので無駄が多いかも？です。 後は応用していただけますと助かります。 一応、こんな感じになりました。 では、、では、、
|[A] |[B] |[C] |[D] |[E]|[F] |[G]|[H]|[I]|[J]|[K]|[L] |[M]|[N]|[O]
[1] |氏名|スキル|所要月|終了月| |スキル|4月|5月|6月| | |スキル|6月|7月|8月
[2] |TBD |S |4月 | | |S | 1| 0| 1| | |A | 0| 2| 0
[3] |TBD |A |5月 | | |A | 0| 2| 0| | |S | 1| 0| 1
[4] |TBD |A |5月 | | | | | | | | | | | |
[5] |TBD |S |6月 | | | | | | | | | | | |
[6] |あ |A |4月 |5月 | | | | | | | | | | |
[7] |あ |A |6月 | | | | | | | | | | | |
[8] |い |S |4月 |6月 | | | | | | | | | | |
[9] |い |S |7月 |8月 | | | | | | | | | | |
[10]|う |S |5月 |6月 | | | | | | | | | | |
[11]|え |A |5月 |7月 | | | | | | | | | | |
[12]|お |A |4月 |7月 | | | | | | | | | | |
Option Explicit
Sub てすと()
Dim v As Variant
Dim vv As Variant
Dim vvv As Variant
Dim w As Variant
Dim z As Variant
Dim i As Long
Dim j As Long
v = Range("A1").CurrentRegion.Resize(, 4).Value
ReDim q(0)
ReDim g(0)
ReDim x(0)
ReDim y(0)
ReDim xx(0)
ReDim yy(0)
ReDim 氏名(0)
ReDim 終了月(0)
ReDim qq(0)
ReDim gg(0)
ReDim ss(0)
ReDim bb(0)
For i = LBound(v, 1) + 1 To UBound(v, 1)
If v(i, 1) = "TBD" Then
z = Application.Match(v(i, 2) & "," & v(i, 3), q, 0)
If IsError(z) Then
ReDim Preserve q(UBound(q) + 1)
ReDim Preserve g(UBound(g) + 1)
q(UBound(q)) = v(i, 2) & "," & v(i, 3)
g(UBound(g)) = 1
Else
g(z - 1) = g(z - 1) + 1
End If
z = Application.Match(v(i, 2), x, 0)
If IsError(z) Then
ReDim Preserve x(UBound(x) + 1)
x(UBound(x)) = v(i, 2)
End If
z = Application.Match(v(i, 3), y, 0)
If IsError(z) Then
ReDim Preserve y(UBound(y) + 1)
y(UBound(y)) = v(i, 3)
End If
Else
If v(i, 4) <> "" Then
z = Application.Match(v(i, 1) & "," & v(i, 2), qq, 0)
If IsError(z) Then
ReDim Preserve qq(UBound(qq) + 1)
ReDim Preserve gg(UBound(gg) + 1)
ReDim Preserve ss(UBound(ss) + 1)
ReDim Preserve bb(UBound(bb) + 1)
qq(UBound(qq)) = v(i, 1) & "," & v(i, 2)
gg(UBound(gg)) = 1
ss(UBound(gg)) = v(i, 4)
bb(UBound(bb)) = v(i, 2) & "," & v(i, 4)
Else
If Val(v(i, 4)) > Val(ss(z - 1)) Then
qq(z - 1) = ""
gg(z - 1) = ""
qq(UBound(qq)) = v(i, 1) & "," & v(i, 2)
gg(UBound(gg)) = 1
ss(UBound(gg)) = v(i, 4)
bb(UBound(bb)) = v(i, 2) & "," & v(i, 4)
End If
End If
z = Application.Match(v(i, 1), 氏名, 0)
If IsError(z) Then
ReDim Preserve 氏名(UBound(氏名) + 1)
ReDim Preserve 終了月(UBound(終了月) + 1)
氏名(UBound(氏名)) = v(i, 1)
終了月(UBound(終了月)) = v(i, 4)
Else
If Val(v(i, 4)) > Val(終了月(z - 1)) Then
終了月(z - 1) = v(i, 4)
End If
End If
Else
z = Application.Match(v(i, 1), 氏名, 0)
If Not IsError(z) Then
氏名(z - 1) = ""
End If
z = Application.Match(v(i, 1) & "," & v(i, 2), qq, 0)
If Not IsError(z) Then
qq(z - 1) = ""
gg(z - 1) = ""
ss(z - 1) = ""
End If
End If
z = Application.Match(v(i, 2), xx, 0)
If IsError(z) Then
ReDim Preserve xx(UBound(xx) + 1)
xx(UBound(xx)) = v(i, 2)
End If
If v(i, 3) <> "" Then
z = Application.Match(v(i, 3), yy, 0)
If IsError(z) Then
ReDim Preserve yy(UBound(yy) + 1)
yy(UBound(yy)) = v(i, 3)
End If
End If
If v(i, 4) <> "" Then
z = Application.Match(v(i, 4), yy, 0)
If IsError(z) Then
ReDim Preserve yy(UBound(yy) + 1)
yy(UBound(yy)) = v(i, 4)
End If
End If
End If
Next
ReDim w(1 To UBound(x) + 1, 1 To UBound(y) + 1)
w(1, 1) = "スキル"
For i = LBound(x) + 1 To UBound(x)
w(i + 1, 1) = x(i)
Next
For j = LBound(y) + 1 To UBound(y)
w(1, 1 + j) = y(j)
Next
For i = LBound(x) + 1 To UBound(x)
For j = LBound(y) + 1 To UBound(y)
z = Application.Match(x(i) & "," & y(j), q, 0)
If Not IsError(z) Then
w(i + 1, j + 1) = g(z - 1)
Else
w(i + 1, j + 1) = 0
End If
Next
Next
Range("F1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
ReDim w(1 To UBound(xx) + 1, 1 To UBound(yy) - 1)
For i = LBound(xx) + 1 To UBound(xx)
w(i + 1, 1) = xx(i)
Next
For j = LBound(yy) + 2 To UBound(yy)
w(1, j - 1) = yy(j)
Next
w(1, 1) = "スキル"
無二リスト v, vv, vvv
For i = LBound(w, 1) + 1 To UBound(w, 1)
For j = LBound(w, 2) + 1 To UBound(w, 2)
z = Application.Match(w(i, 1) & "," & w(1, j), vv, 0)
If Not IsError(z) Then
w(i, j) = vvv(z - 1)
Else
w(i, j) = 0
End If
Next
Next
Range("L1").Resize(UBound(w, 1), UBound(w, 2)).Value = w
Erase v, vv, vvv, w, q, g, x, y, xx, yy, 氏名, 終了月, qq, gg, ss, bb
End Sub
Sub 無二リスト(ByVal v As Variant, ByRef qq As Variant, ByRef gg As Variant)
Dim z As Variant
ReDim q(0)
ReDim g(0)
ReDim qq(0)
ReDim gg(0)
Dim i As Long
For i = LBound(v, 1) To UBound(v, 1)
If v(i, 4) <> "" Then
z = Application.Match(v(i, 1), q, 0)
If IsError(z) Then
q(UBound(q)) = v(i, 1)
g(UBound(g)) = v(i, 2) & "," & v(i, 4)
ReDim Preserve q(UBound(q) + 1)
ReDim Preserve g(UBound(g) + 1)
Else
If Val(v(i, 4)) > Val(q(z - 1)) Then
q(z - 1) = ""
g(z - 1) = ""
q(UBound(q)) = v(i, 1)
g(UBound(g)) = v(i, 2) & "," & v(i, 4)
ReDim Preserve q(UBound(q) + 1)
ReDim Preserve g(UBound(g) + 1)
End If
End If
Else
z = Application.Match(v(i, 1), q, 0)
If Not IsError(z) Then
q(z - 1) = ""
g(z - 1) = ""
End If
End If
Next
For i = LBound(g) To UBound(g)
z = Application.Match(g(i), qq, 0)
If IsError(z) Then
qq(UBound(qq)) = g(i)
gg(UBound(gg)) = 1
ReDim Preserve qq(UBound(qq) + 1)
ReDim Preserve gg(UBound(gg) + 1)
Else
gg(z - 1) = gg(z - 1) + 1
End If
Next
End Sub
（SoulMan） 2025/02/23(日) 08:38:59
もしもPIVOTBY,GROUPBYが使える環境なら...
最初の式 =LET(a,A2:D12, PIVOTBY(INDEX(a,,2),INDEX(a,,3),INDEX(a,,3),COUNTA,,0,-1,0,,INDEX(a,,1)="TBD"))
2番目の式 =LET(a,A2:D12, b,GROUPBY(TAKE(a,,2),TAKE(a,,-1),LAMBDA(r,INDEX(TAKE(r,-1),1)),,0,, (TAKE(a,,1)<>"TBD")*(COUNTIFS(TAKE(a,,-1),"",TAKE(a,,1),TAKE(a,,1))=0)), PIVOTBY(INDEX(b,,2),INDEX(b,,3),INDEX(b,,3),COUNTA,,0,-1,0)) （んなっと） 2025/02/23(日) 09:13:47
2番目の式は、[い]の[6月],[8月]のうち「下の方」の[8月]を採用しています。 [12月]の次が[1月]になるかもしれないからです。
実は[6か月],[8か月]という意味で、「大きい方」の[8か月]を採用するなら =LET(a,A2:D12, b,GROUPBY(TAKE(a,,2),TAKE(a,,-1),LAMBDA(r,MAX(SUBSTITUTE(r,"月",)*1)&"月"),,0,, (TAKE(a,,1)<>"TBD")*(COUNTIFS(TAKE(a,,-1),"",TAKE(a,,1),TAKE(a,,1))=0)), PIVOTBY(INDEX(b,,2),INDEX(b,,3),INDEX(b,,3),COUNTA,,0,-1,0)) （んなっと） 2025/02/23(日) 09:48:35
vbaでもう一例
Sub test()
Dim s$(1), i&, n&, ws As Worksheet
Application.ScreenUpdating = False
Set ws = ActiveSheet
ws.[f:f].Resize(, 13).ClearContents
s(0) = "Transform IIf(Count(*),Count(*),0) Select スキル From `^$` Where 氏名= 'TBD' " & _
"Group By スキル Order By スキル Desc Pivot Format(所要月,'m月');"
s(1) = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties='Excel 12.0;HDR=Yes';"
With CreateObject("ADODB.Recordset")
.Open Replace(s(0), "^", ws.Name), s(1)
For i = 0 To .Fields.Count - 1
ws.Cells(1, i + 6) = .Fields(i).Name
Next
ws.[f2].CopyFromRecordset .DataSource
.Close
s(0) = "Transform IIf(Count(*),Count(*),0) Select スキル From (Select 氏名, スキル, " & _
"Max(終了月) As `終了月` From `^$` Where 氏名 <> 'TBD' Group By 氏名, スキル " & _
"Having Count(終了月) = Count(氏名))" & _
"Group By スキル Order By スキル Desc Pivot Format(終了月,'m月');"
.Open Replace(s(0), "^", ws.Name), s(1), 3, 3, 1
n = ws.Range("f" & Rows.Count).End(xlUp)(3).Row
For i = 0 To .Fields.Count - 1
ws.Cells(n, i + 6) = .Fields(i).Name
Next
ws.Cells(n + 1, 6).CopyFromRecordset .DataSource
End With
Application.ScreenUpdating = True
End Sub
（jindon） 2025/02/23(日) 19:22:20
色々とご教示いただきありがとうございます。
諸事情でvbaが使用できなく、関数で実施出来ればと思っております。
PIVOTBY,GROUPBYについては、調査してみましたが、使用できませんでした。
申し訳ございませんが、今一度、関数での対応方法をご教示いただければと思います。
（POKO） 2025/02/26(水) 19:32:12
最初の式
=LET(a,A2:D12,
b,FILTER(CHOOSECOLS(a,2,3),INDEX(a,,1)="TBD"),
c,SORT(UNIQUE(TAKE(b,,1)),,-1),
d,TRANSPOSE(SORT(UNIQUE(TAKE(b,,-1)))),
e,MAP(c&d,LAMBDA(i,COUNT(0/BYROW(b,LAMBDA(r,CONCAT(r)=i))))),
VSTACK(HSTACK("",d),HSTACK(c,e)))
2番目の式...[い]の[6月],[8月]のうち「下の方」の[8月]を採用
=LET(x,A2:D12,
a,FILTER(x,(TAKE(x,,1)<>"TBD")*(COUNTIFS(TAKE(x,,-1),"",TAKE(x,,1),TAKE(x,,1))=0)),
b,FILTER(CHOOSECOLS(a,2,4),XMATCH(TAKE(a,,1),TAKE(a,,1),,-1)=SEQUENCE(ROWS(a))),
c,SORT(UNIQUE(TAKE(b,,1)),,-1),
dd,UNIQUE(TOROW(TAKE(x,,-2),3),TRUE),d,SORTBY(dd,SUBSTITUTE(dd,"月",)*1),
e,MAP(c&d,LAMBDA(i,COUNT(0/BYROW(b,LAMBDA(r,CONCAT(r)=i))))),
VSTACK(HSTACK("",d),HSTACK(c,e)))
2番目の式...実は[6か月],[8か月]という意味で、「大きい方」の[8か月]を採用
=LET(x,A2:D12,
a,FILTER(x,(TAKE(x,,1)<>"TBD")*(COUNTIFS(TAKE(x,,-1),"",TAKE(x,,1),TAKE(x,,1))=0)),
y,UNIQUE(TAKE(a,,2)),
b,HSTACK(TAKE(y,,-1),BYROW(y,LAMBDA(r,
LET(p,FILTER(TAKE(a,,-1),BYROW(TAKE(a,,2),LAMBDA(i,AND(i=r)))),
MAX(SUBSTITUTE(p,"月",)*1)&"月")))),
c,SORT(UNIQUE(TAKE(b,,1)),,-1),
dd,UNIQUE(TOROW(TAKE(x,,-2),3),TRUE),d,SORTBY(dd,SUBSTITUTE(dd,"月",)*1),
e,MAP(c&d,LAMBDA(i,COUNT(0/BYROW(b,LAMBDA(r,CONCAT(r)=i))))),
VSTACK(HSTACK("",d),HSTACK(c,e)))
（んなっと） 2025/02/26(水) 21:06:45
関数ではないですが、[データ]→[テーブルまたは範囲から]→PowerQueryエディターで[詳細エディター]
let
ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
fil = Table.SelectRows(ソース, each ([氏名] <> "TBD")),
mon = List.Sort(List.RemoveNulls(List.Distinct(fil[所要月] & fil[終了月]))),
grp = Table.Group(fil, {"氏名"}, {{"group", each _, type table}}),
trs =Table.TransformColumns(grp,{"group", each
if List.Contains(_[終了月],null) then null
else Table.LastN(_, 1)}),
sel = Table.SelectRows(trs,each Value.Is(_[group],Table.Type)),
cmb = Table.Combine(sel[group]),
del = Table.RemoveColumns(cmb,{"氏名"}),
piv = Table.Pivot(del, mon, "終了月", "所要月", List.Count),
srt2 = Table.Sort(piv,{{"スキル", Order.Descending}})
in
srt2
（んなっと） 2025/02/26(水) 21:12:19
ご教示いただきありがとうございます。
一旦のリスト表示ができること、確認できました。
出来れば、下記のようなフォーマットにカウントが表示されるようにしたいのですが、可能でしょうか？
スキル 4月 5月 6月 7月 8月 9月 10月 11月 12月 1月 2月 3月
ｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰｰ
S
A
恐れ入りますが、今一度のご教示、どうぞよろしくお願いいたします。
（POKO） 2025/03/03(月) 10:55:37
●
=LET(a,A2:D12,
b,FILTER(CHOOSECOLS(a,2,3),INDEX(a,,1)="TBD"),
c,SORT(UNIQUE(TAKE(b,,1)),,-1),
d,MOD(SEQUENCE(,12,3),12)+1&"月",
e,MAP(c&d,LAMBDA(i,SUM(1*BYROW(b,LAMBDA(r,CONCAT(r)=i))))),
VSTACK(HSTACK("",d),HSTACK(c,e)))
●
=LET(x,A2:D12,
a,FILTER(x,(TAKE(x,,1)<>"TBD")*(COUNTIFS(TAKE(x,,-1),"",TAKE(x,,1),TAKE(x,,1))=0)),
b,FILTER(CHOOSECOLS(a,2,4),XMATCH(TAKE(a,,1),TAKE(a,,1),,-1)=SEQUENCE(ROWS(a))),
c,SORT(UNIQUE(TAKE(b,,1)),,-1),
d,MOD(SEQUENCE(,12,3),12)+1&"月",
e,MAP(c&d,LAMBDA(i,SUM(1*BYROW(b,LAMBDA(r,CONCAT(r)=i))))),
VSTACK(HSTACK("",d),HSTACK(c,e)))
●
let
ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
fil = Table.SelectRows(ソース, each ([氏名] <> "TBD")),
mon = List.Transform({3..14}, each Text.From(Number.Mod(_,12)+1) & "月"),
grp = Table.Group(fil, {"氏名"}, {{"group", each _, type table}}),
trs =Table.TransformColumns(grp,{"group", each
if List.Contains(_[終了月],null) then null
else Table.LastN(_, 1)}),
sel = Table.SelectRows(trs,each Value.Is(_[group],Table.Type)),
cmb = Table.Combine(sel[group]),
del = Table.RemoveColumns(cmb,{"氏名"}),
piv = Table.Pivot(del, mon, "終了月", "所要月", List.Count),
srt2 = Table.Sort(piv,{{"スキル", Order.Descending}})
in
srt2
（んなっと） 2025/03/03(月) 11:45:11
関数のご提示ありがとうございます。
実際に問題なく表示できること、確認できました。
ありがとうございました。
（POKO） 2025/03/03(月) 13:09:39
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.