セルの中身で一番多い数字を抽出

セルの中身で一番多く含まれている数字を抽出したいです。

同数はすべて表示したいです。
できれば一個のセルで処理したいですが、作業用セルをつくってもかまいません。

たとえばこんな感じです。
123413579→13
5678914758→578
36924837→３

よろしくお願いします。

No.2 回答者： WindFaller 回答日時： 2018/11/24 19:36

こんばんは。

数式では、このようになりましたが、1個しか出てきません。横にドラッグコピーします。
=MOD(LARGE(INDEX((LEN($A1)-LEN(SUBSTITUTE($A1,COLUMN($A$1:$J$1)-1,"")))+COLUMN($A$1:$J$1)/10,,),COLUMN(A$1)),1)*10-1

多い順からセル1つに1つずつでますが、横にコピーすると、全部が出てきてしまいます。
以下のA1の場合は、4,5,3 となってしまいます。

VBAでは、このようにすればできるはずです。
使い方は、簡単。
A1:123451243456
A2:5678914758
A3:3692400837

=CountNums(A1) ->4 (最大の数しか出ません。）
=CountNums(A2) ->578
=CountNums(A3) ->03

'//標準モジュール
Function CountNums(ByVal セル As Variant)
　Dim strNums As String
　Dim textLen As Long
　Dim ret As Variant, arbuf(0 To 9) As Long
　Dim i As Long, buf As Variant
　Dim cMax As Long
　Application.Volatile '再計算を繰り返すようなら、先頭に「'」シングルコーテーションを入れてください。
　If Not IsNumeric(セル.Text) Then CountNums = ""
　strNums = セル.Value2
　textLen = Len(strNums)
　buf = "": ret = 0
　For i = 0 To 9
　　ret = textLen - Len(Replace(strNums, i, ""))
　　If ret > 0 Then
　　　arbuf(i) = ret
　　　If cMax < ret Then cMax = ret '最大数をカウント
　　End If
　　ret = ""
　Next
　For i = 0 To 9
　　If arbuf(i) = cMax Then
　　　buf = buf & i
　　End If
　Next
　CountNums = buf
End Function

この回答へのお礼

ありがとうございます。解決しました。

お礼日時：2018/12/03 15:35

No.1 回答者： tom04 回答日時： 2018/11/23 18:55

こんばんは！

VBAになりますが、一例です。
1行目は項目行でA列2行目以降にデータがあるとし、B列に表示するとします。

Sub Sample1()
　Dim i As Long, k As Long, c As Range
　Dim myMax As Long, myStr As String
　　For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
　　　For k = 1 To Len(Cells(i, "A"))
　　　　Set c = Range("D:D").Find(what:=Mid(Cells(i, "A"), k, 1), LookIn:=xlValues, lookat:=xlWhole)
　　　　　If Not c Is Nothing Then
　　　　　　With c.Offset(, 1)
　　　　　　　.Value = .Value + 1
　　　　　　End With
　　　　　Else
　　　　　　With Cells(Rows.Count, "D").End(xlUp).Offset(1)
　　　　　　　.Value = Mid(Cells(i, "A"), k, 1)
　　　　　　　.Offset(, 1) = 1
　　　　　　End With
　　　　　End If
　　　Next k
　　　　myMax = WorksheetFunction.Max(Range("E:E"))
　　　For k = 2 To Cells(Rows.Count, "D").End(xlUp).Row
　　　　　　If Cells(k, "E") = myMax Then
　　　　　myStr = myStr & Cells(k, "D")
　　　　End If
　　　Next k
　　　　Cells(i, "B") = myStr
　　　　myStr = ""
　　　　Range("D:E").ClearContents
　　Next i
End Sub

※　作業用の列として、D・E列を使っていますので、
D・E列にはなにもデータがないようにしておいてください。

※　質問文は数値データで、「0」がありませんが、
万一「0」が最大個数で、最初に出現する場合は
「0」が表示されないかもしれません。m(_ _)m

この回答へのお礼

ありがとうございます。解決しました。

お礼日時：2018/12/03 15:35