エクセル 表の人数を計算したい。（部署ごとに）

エクセルを使用して、資格表を作成しました。
その表の　各部署の人数を計算したいです。
下記をご覧ください。

　　　１　　　　　　２　　　　　　３　　　　　　　
A　　総務部　　　　鈴木　　　　普通自動車免許
B　　総務部　　　　鈴木　　　　簿記３級
C　　総務部　　　　木村　　　　秘書検２級
D　　経理部　　　　浅田　　　　簿記２級
E　　経理部　　　　浅田　　　　普通自動車免許
F　　営業部　　　　酒井　　　　宅建

上記の表で、部署に何名所属しているか計算したいです。
※重複した人は数えない
上の表だと、
総務部：２名　　　経理部：１名　　　　営業部：１名
これを計算するにはどうすればいいですか？
※別シートに人数を計算する場合

自分で式を作ってみましたが、エラーが出てしまいます。

=SUMPRODUCT(1/COUNTIF('別シート'!$B:$D,A1))
これを使用すると、0.09090909など小数点が出てきます。

なにか方法があれば教えてください。

No.1 回答者： d-q-t-p 回答日時： 2018/05/16 13:42

> =SUMPRODUCT(1/COUNTIF('別シート'!$B:$D,A1))

どっかで見つけた式を思いつきで使ったんでしょうけど……

COUNTIFじゃ話になりませんし そもそも「A1」だけ指定しても意味が
ありません。もし本当に「列」で指定するなら COUNTIFSでの処理を
１０４万行に対して実行してそれを合計することになります。

最悪フリーズする可能性があるので 間違ってて良かったというべきで
しょうね。

> なにか方法があれば教えてください。
データ量がどのくらいあるのか明示しておくべきだと思います。
数式で対応するのは せいぜい数千～１万行くらいまでです。

別シートの E列に
=1/COUNTIFS(B:B,B1,C:C,C1)
最終行までコピー

E列を SUMで合計すればいいでしょう。

この回答へのお礼

急いでいたので、簡易的に記載してしまいすみません。
ご回答ありがとうございました。

お礼日時：2018/05/17 11:03

No.2 回答者： 銀鱗 回答日時： 2018/05/16 14:08

＞エクセルを使用して、資格表を作成しました。

（中略）
＞下記をご覧ください。

ええと、
A2セルに「A」、A3セルに「B」…B1セルに「1」、C1セルに「2」…などと入力する意味無いと思うんだ。

・・・本題・・・

自分ならCOUNTIFS関数を使って同じ名前がいくつあるのかを数えるふりをして、一番初めにカウントされた名前だけを再度COUNTIFS関数でカウントするような事をする。
作業用の列を設けて、一時的な結果を表示させるようにして、それを集計するという感じですね。


・・・余談・・・

ピボットテーブルを使うと幸せになれるような気もしなくはない。

No.3 回答者： angkor_h 回答日時： 2018/05/16 14:10

元表を作り替えた方が良いと思います。

部門名、氏名、資格1、資格2、資格3、…
として、1人毎に、該当資格に「1」を入れる、とか。

提示式における、1/COUNTIF()の意味が不明です。
たぶん重複数で割っているようですが、その個人名指定が無いのが欠点です。

この回答へのお礼

元表は作り変えられませんので、方法を探していました。
私の説明不足でしたが、資格ごとに記載しているのは手当金なども入力されているからです。
ご回答いただき、ありがとうございます。

お礼日時：2018/05/17 11:00

No.4 ベストアンサー 回答者： tom04 回答日時： 2018/05/16 14:18

こんにちは！

「資格」に関しては無視で良いのですね。

手っ取り早くVBAでの一例です。
↓の画像のような配置で元データはSheet1にあり、Sheet2に表示するとします。

標準モジュールにしてください。

Sub Sample1()
Dim myDic As Object
Dim i As Long, lastRow As Long
Dim wS As Worksheet
Dim myKey, myItem, myR, myAry

Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Range("A:B").ClearContents
With Worksheets("Sheet1")
wS.Range("A1") = .Range("A1")
wS.Range("B1") = "人数"
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
myR = Range(.Cells(2, "A"), .Cells(lastRow, "B"))
For i = 1 To UBound(myR, 1)
If Not myDic.exists(myR(i, 1)) Then
myDic.Add myR(i, 1), myR(i, 2)
Else
If InStr(myDic(myR(i, 1)), myR(i, 2)) = 0 Then
myDic(myR(i, 1)) = myDic(myR(i, 1)) & "_" & myR(i, 2)
End If
End If
Next i
End With
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myAry = Split(myItem(i), "_")
wS.Cells(i + 2, "A") = myKey(i)
wS.Cells(i + 2, "B") = UBound(myAry) + 1
Next i
Set myDic = Nothing
MsgBox "完了"
End Sub

上記マクロを実行すると
画像のような感じになります。m(_ _)m

この回答へのお礼

ありがとうございます。
試してみます！！！

お礼日時：2018/05/17 10:59