質問: エクセル関数・vba 条件に合致したセルの個数を重複を除いて求めたい。 こんにちは、お手数おかけしますが教えてください。 windows10、excel2016を使用しています。 添付写真、a1:c23の入力データがあるとします。 そのデータを元にe1:i4の別途表に集計をしたく考えています。 集計したい事は「人ごとの重複を除いた日付の個数」です。 よろしくお願いいたします。 ※a~cの各列は名前の管理にて人・日付・金額として可変で範囲指定しています。 また、a:cをリストとして可変で範囲指定しています。 ※f1:i1は表示形式にてm月としています。入力は2017/3/1というように各月の1日です。 ※e1:i4の別途表は3月~翌2月まで続きます。 ※人は全部で30人います。 以上、よろしくお願いいたします。
回答: こんばんは。 日付の個数というのは、同じ人が、3/1 が2つあっても、1つと勘定するという意味だと思います。後は、書き出し位置など場所さえ間違えなければ、ちゃんとした計算はされるはずです。 '//標準モジュールに貼り付けてください。 sub summaryperperons() dim objdic as object 'new scripting.dictionary dim i as long, j as long dim lastrow as long dim rng as range dim c as variant, d as variant, k as long, p dim arymon, ary k = 2 'e列書きだし場所 with activesheet for i = 1 to 12 .range("e1").offset(, i).value = (i + 12 - 11) mod 12 + 1 & "月" next if .autofiltermode = true then .autofiltermode = false end if set objdic = createobject("scripting.dictionary") set rng = .range("a2", .cells(rows.count, 1).end(xlup)) for each c in .range("a2", .cells(rows.count, 1).end(xlup)) if (objdic.exists(c.value)) = false then objdic.add c.value, i i = i + 1 end if next c ary = objdic.keys '人名の書き出し for i = 1 to ubound(ary) .cells(i + 1, "e").value = ary(i - 1) next lastrow = rng(rng.cells.count).row objdic.removeall redim arymon(12) as integer '月のデータ application.screenupdating = false '日付の集計 for each p in ary .autofiltermode = false .range("a1").resize(lastrow, 3).autofilter .autofilter.range.autofilter _ field:=1, _ criteria1:="=" & p for each d in .autofilter.range.columns(2).specialcells(xlcelltypevisible).cells d.select if vartype(d.value) = vbdate then if (objdic.exists(d.value)) = false then arymon(month(d.value)) = arymon(month(d.value)) + 1 objdic.add d.value, arymon i = i + 1 end if end if next '日付の出力 for i = 1 to ubound(arymon) j = (i + 12 - 11) mod 12 + 1 '...3月が1番目の時 cells(k, "e").offset(, i).value = arymon(j) next i erase arymon redim arymon(12) as integer objdic.removeall k = k + 1 next .autofiltermode = false .range("e1").select end with application.screenupdating = true beep end sub