エクセルでの集計関数Ｎｏ．２

質問

前回の質問より複雑なデータの集計が飛び込んで困っています。
例
　　　Ａ　　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　　　Ｆ　　　Ｇ　　　Ｈ　　　Ｉ　　　Ｊ
１　　鈴木　田中　佐藤　八木　石島　須藤　徳間　遠藤　伊藤　斉藤
２　　田中　八木　田中　遠藤　鈴木　伊藤　佐藤　佐藤　鈴木　徳間
３　　石島　鈴木　徳間　鈴木　伊藤　．．．．
といったデータが存在しています（Ａ１：Ｊ３）の範囲内で最頻値の文字列を検出する関数の組み合わせを教えてください。回答例　鈴木　
しかも、鈴木　佐藤が同一の場合メッセージを表示させるには．．とほほです。よろしくお願いします。

回答No.1

BLUEPIXY · ベストアンサー

通常の関数ではメッセージを表示させることはできないので、
ユーザー定義関数を使いましょう。
----------------------------------------------------------------
'一番重複しているデータを返す
'mode()があるが、数値しか対応していないため
Public Function modea(r As Range)
Dim objList, x, maxCount, maxKey
Set objList = CreateObject("Scripting.Dictionary")
For Each x In r
If Not objList.Exists(x.Value) Then '新しいオブジェクト
objList.Add x.Value, 1
Else '重複出現時カウント＋１
objList.Item(x.Value) = objList.Item(x.Value) + 1
End If
Next
maxCount = 0: maxKey = ""
For Each x In objList.Keys
If objList.Item(x) > maxCount Then
maxCount = objList.Item(x)
maxKey = x
End If
Next
For Each x In objList.Keys
If objList.Item(x) = objList.Item(maxKey) Then '同一個数のものがある
MsgBox "同一件数のデータ：" & x
End If
Next
modea = maxKey
End Function
----------------------------------------------------------------
使い方
=modea(A1:J3)
問題点、入力されないセルは、０値としてカウントされる。
入力されないセルが多い場合には、それが、最頻出値として選ばれる。
善し悪しなので、問題になる場合は、変更してください。

回答No.2

BLUEPIXY

#1では、他に同一のものが無い場合自分をメッセージで表示してしまうので、そこと、入力が無いモノをスキップするように変更してみました。
----------------------------------------------------------------
Public Function modea(r As Range)
Dim objList, x, maxCount, maxKey
Set objList = CreateObject("Scripting.Dictionary")
For Each x In r
If IsEmpty(x) Then GoTo continue
If Not objList.Exists(x.Value) Then '新しいオブジェクト
objList.Add x.Value, 1
Else '重複出現時カウント＋１
objList.Item(x.Value) = objList.Item(x.Value) + 1
End If
continue: Next
maxCount = 0: maxKey = ""
For Each x In objList.Keys
If objList.Item(x) > maxCount Then
maxCount = objList.Item(x)
maxKey = x
End If
Next
For Each x In objList.Keys
If objList.Item(x) = objList.Item(maxKey) And x <> maxKey Then '同一個数のものがある
MsgBox "同一件数のデータ：" & x
End If
Next
Set objList = Nothing
modea = maxKey
End Function
'問題点：色んな場所で使った場合、どこの処理ででたメッセージなのかわからん！、やたらでるとうるさい。

お礼

前回に続きありがとうございます。おかげで解決できました。
勉強不足を痛感しております。有難うございました。