Excel範囲内の文字の多い順に列記

質問

Excel範囲内（D2:F6）の文字の内、多い文字をB２から順に５個列記したいのですがB２～B6に入力する計算式がわかる方よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.3

KURUMITO · ベストアンサー

関数で対応する方法です。
なおお示しの表でA1セルには順位を、C1セルには個数を項目名と入力します。
順位ですが得点が同じであれば順位は同じになります。4位まででも5人を変える場合には4位までの表示にします。
D,E,F列に入力されているデータがどんな文字列だけが入力されているのかわからない状況で入力されている文字列を自動的に求めすべてのデータを対象にしてA,B,Cのデータを自動で表示させるためには次のように作業列を作って対応することにします。
J2セルには次の式を入力します。

=IF(ROW(A1)<=MATCH("ー",D:D),INDEX(D:D,ROW(A1)),IF(ROW(A1)<=MATCH("ー",D:D)+MATCH("ー",E:E),INDEX(E:E,ROW(A1)-MATCH("ー",D:D)),IF(ROW(A1)<=MATCH("ー",D:D)+MATCH("ー",E:E)+MATCH("ー",F:F),INDEX(F:F,ROW(A1)-MATCH("ー",D:D)-MATCH("ー",E:E)),"")))

上の式でMATCH関数のーは必ず半角モード-ではなくひらがなモードでのーであることが必要です。一旦式を確定した後で数式バー上で見直しし、－をーに変えるなどの操作が必要となるでしょう。

K2セルには次の式を入力します。

=IF(OR(J2="",J2=0),"",IF(COUNTIF(J$2:J2,J2)=1,COUNTIF(J:J,J2),""))

L2セルには次の式を入力します。

=IF(K2="","",K2-COUNTIF(K$2:K2,K2)*10^-2)

J2セルからL2セルまでを選択してからそれらの式を下方に（お示しの場合には25行以上下方まで）ドラッグコピーします。

そこでお求めのA,B,C列ですがA2セルには次の式をC2セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(ROW(A1)>COUNT($K:$K),"",IF(RANK(LARGE($K:$K,ROW(A1)),$K:$K,0)>5,"",IF(COLUMN(A1)=1,RANK(LARGE($K:$K,ROW(A1)),$K:$K,0),IF(COLUMN(A1)=2,INDEX($J:$J,MATCH(LARGE($L:$L,ROW(A1)),$L:$L,0)),IF(COLUMN(A1)=3,LARGE($K:$K,ROW(A1)),"")))))

お礼

ありがとうございます。難しそうですが勉強して理解します。

回答No.2

bunjii

B列に予め文字を入力してC列に対象範囲のセルに有る文字と一致するセルの個数を算出しC列をキーとしてB列とC列を降順ソートする方法では如何ですか？

お礼

ありがとうございます。

回答No.1

tom04

こんばんは！
お望みの関数ではなく、VBAになってしまいますが一例です。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim cnt As Long, endRow As Long, c As Range, myArea As Range, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set myArea = wS1.Range("D2:F8") '←範囲はここで指定

endRow = wS1.Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
Range(wS1.Cells(2, "B"), wS1.Cells(endRow, "C")).ClearContents
For Each c In myArea
If c <> "" And WorksheetFunction.CountIf(wS2.Range("A:A"), c) = 0 Then
cnt = cnt + 1
With wS2.Cells(cnt, "A")
.Value = c
.Offset(, 1) = WorksheetFunction.CountIf(myArea, c)
End With
End If
Next c
wS2.Range("A1").CurrentRegion.Sort key1:=wS2.Range("B1"), order1:=xlDescending, Header:=xlNo
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
With Range(wS2.Cells(1, "C"), wS2.Cells(endRow, "C"))
.Formula = "=RANK(B1,B:B)"
.Value = .Value
End With
If wS2.Cells(5, "C") <> wS2.Cells(6, "C") Then
wS2.Range("A1").Resize(5, 2).Copy wS1.Range("B2")
Else
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
For cnt = endRow To 5 Step -1
If wS2.Cells(cnt, "C") <> wS2.Cells(5, "C") Then
wS2.Rows(cnt).Delete
End If
Next cnt
wS2.Range("C:C").Clear
wS2.Range("A1").CurrentRegion.Copy wS1.Range("B2")
End If
wS2.Cells.Clear
Application.ScreenUpdating = True
End Sub 'この行まで

※　Sheet1に画像のようなデータがあり、Sheet2を作業用のSheetとして使用していますので、
Sheet2は全く使用していないSheetを準備しておいてください。

※　余計なお世話かもしれませんが、上位5番目のデータが複数ある場合は同順位を
すべて表示するようにしています。m（_ _）m

お礼

ありがとうございます。関数にて対応したかったので。