順位をつける範囲について

質問

以下のようなデータがあります。
　 A　 B
1　あ　3.0
2　あ　3.0
3　あ　3.0
4　あ　3.0
5　い　1.5
6　い　1.5
7　あ　3.0
8　あ　3.0
9　い　1.5
10 い　1.5
11 う　6.8
12 う　6.8

この「あ」「い」「う」の順位を決定するのに、C列にRANK関数を使って範囲をB1：B12にすると
　 A　 B　 　C　　D
1　あ　3.0　 5　　2
2　あ　3.0　 5　　2
3　あ　3.0　 5　　2
4　あ　3.0　 5　　2
5　い　1.5　 1　　1
6　い　1.5　 1　　1
7　あ　3.0　 5　　2
8　あ　3.0　 5　　2
9　い　1.5　 1　　1
10 い　1.5　 1　　1
11 う　6.8　 11　 3
12 う　6.8　 11　 3
となります。でも実際には順位はD列のようにならないといけないですよね。

A列の「あ」「い」「う」がアトランダムにある場合に（A列のどこに存在しても）D列のような順位を出す方法を教えてください。

よろしくお願いいたします。

回答No.5

BLUEPIXY · ベストアンサー

＃３補足>VBAに記載できるならOKなのですが上のマクロはそれは可能ですか？
ＶＢＡで、挿入～標準モジュールして
＃３をコピー＆ペーストして下さい。
それで、ワークシートから使えるようになります。
myRankは、エクセルのRank関数を模したもので、置き換えて使えます。
変な動作をするようであれば補足して下さい。
ちなみに、
Rankは、対象が数値のみですが
myRankは、対象が文字列でも大丈夫ですので、
もとの対象の範囲は、Ｂ列になっていてそのままでもよいですが、
Ａ列を対象としても動作します。その場合は、順序はＡ列を文字列としてソートしたような順番になります。
（文字列のソートは、順番が思ったようなものにならない場合があることに注意）

お礼

いや～！すばらしい。完璧に出来ました。すごいの一言です。ありがとうございました。

回答No.4

keydaimon

ちなみに、その数字の例えば
２ー７
の７の部分（下１桁）の最後の数字は決まってるんですか？

お礼

補足の補足です。すなわち頭も1から8まで、最後の数字も1から8まで。

(1)しかし、「1-1」や「2-2」などはあったりなかったり(ケースによって変化）しますし、「1-2」はあっても逆の「2-1」はありません。「3-2」や「8-7」などもありません。

(2)また質問のように「1-2」がA1、A2、A7、A8と飛んで出現したりします。
(1)(2)の意味でアトランダムにあるという表現です。

補足

「1-1」から「1-8」というながれで「8-8」まであります。（最大で36個）

回答No.3

BLUEPIXY

前に、順位を飛ばさない順位付け関数を作ったことがあるので、それを再掲します。
RANK関数をmyRankに代えて使ってみてください。
myLargeやmySmallは、同じことなので、おまけです。
----------------------------------------------------------------
Private Function asSet(r As Range) '重複しない数値データの配列にする
Dim NumList
Dim x As Range, i
Set NumList = CreateObject("Scripting.Dictionary")
For Each x In r
If Not NumList.Exists(x.Value) Then '重複チェック
NumList.Add x.Value, 1
Else '重複時の処理
NumList.Item(x.Value) = NumList.Item(x.Value) + 1
End If
Next
asSet = NumList.Keys
End Function
Private Sub ArraySort(a, Optional ascending = 0) '規定値は大きいもの順
Dim wk, i As Integer, j As Integer, k As Integer
Dim n
n = UBound(a)
k = n \ 2
Do While (k > 0) 'シェルソート
For i = 0 To n - k
j = i
Do While (j >= 0)
If a(j) > a(j + k) Then
wk = a(j)
a(j) = a(j + k)
a(j + k) = wk
j = j - k
Else
Exit Do
End If
Loop
Next
k = k \ 2
Loop
If ascending = 0 Then '逆順にする
i = 0: j = n
Do Until (i >= j)
wk = a(i)
a(i) = a(j)
a(j) = wk
i = i + 1: j = j - 1
Loop
End If
End Sub
Public Function myRank(v, r As Range, Optional ascending = 0) '順位が重複しても順位を飛ばさない
Dim a, i, x
a = asSet(r)
Call ArraySort(a, ascending)
i = 0
For i = 0 To UBound(a)
If v = a(i) Then myRank = i + 1: Exit Function
Next
End Function
Public Function myLarge(r As Range, rank) '重複する値は同じ順位
Dim a, i, x
a = asSet(r)
Call ArraySort(a)
myLarge = a(rank - 1)
End Function
Public Function mySmall(r As Range, rank) '重複する値は同じ順位
Dim a, i, x
a = asSet(r)
Call ArraySort(a, 1)
mySmall = a(rank - 1)
End Function

補足

す、すみません。VBAに記載できるならOKなのですが上のマクロはそれは可能ですか？
(たぶん可能なのでしょうが、その方法がわかりません。
技術者向きのコーナーで別の質問をした際に、同じようなマクロの記述を頂いたにもかかわらず移植することができなくて（VBAがほんのちょっぴりしかわからない未熟者なので）馬鹿にされた経験があるので・・・）

上の例で言えば、C1セルを選択しExcelの関数”RANK”を使ってRANK（B1,$B$1:$B$12,1)のように使っていたので質問の「RANK関数」という表現は間違ってましたかね～？

VBAでできるのであればかなり重宝な気が致します。

回答No.2

keydaimon

調べてみたのですが、RANK関数では、順序付けが自分で指定できないようなので、別の方法を使ってみますね。

たとえば、文字コードに変換するという方法をとります。

具体的にいいうと、「あ」という文字は、文字コードが９２５０なのだそうです。ここからいっこずつずれていくので、「い」は９２５１、「う」は９２５３...「ん」は９３３１となります。

そのように変換する関数はCODE関数です。
CODE('あ')=9250となります。

そこで、D列には同じ行のA列の値を参照し、文字コードを返し、その値から９２４９を引けば、「あ」＝１、「い」＝２となると思います。

参考までに、CODE関数と対になる関数は、CHAR関数です。

参考URL：

http://www3.tokai.or.jp/excel/kansu/code.htm

お礼

質問にはデータの「例」として「あ」「い」「う」を挙げましたが、実際の文字は「1-5」「2-2」「3-6」「4-8」「5-6」「5-7」「5-8」「6-7」などという文字列なのです。この場合でも回答を参照して実践できそうですか？

補足

下のお礼の追加ですが、CODEだと先頭文字を変換するから厳しいですね。
それに仮に変換できたとしても質問のD列のような順位は得られない気がします（やはりC列のようになってしまうのでは・・・）

回答No.1

keydaimon

この問題の「あ」「い」「う」のように三文字についての順位をつけたいのであれば、if関数を使ってみてはいかがでしょうか？

もっと多くなると実用的ではないですが...

お礼

多いです。60個くらいあります。