LANK関数で求めた順位

質問

Win　xp Office2003　Excel

LANK関数で求めた順位で順位が２人あるものは次の順位が２位が二人の場合４位になります。それを欠番なしで３位にする方法教えてください

A　　　　B　　　C
氏名　　成績　　順位
A子　　　65　　　3
B子　　　62　　　4
C子　　　73　　　1
D子　　　59　　　5
E子　　　70　　　2
F子　　　55　　　6
G子　　　70　　　2

回答No.2

mcq · ベストアンサー

shkwtaさんのやり方でうまくできますよ。
順位を求めた後に再度氏名順に並べたい時は、Ｃ列をコピーし、Ｄ列に形式を選択して貼り付け→値→ＯＫ、Ｃ列を削除した後、氏名で並び替え。です。

お礼

ありがとうございました。出来ました

回答No.3

BLUEPIXY

ユーザー定義関数myRankを作ってみました
使い方は、Rankと同じmyRank(値,範囲[,順序])
ALT+F11で標準モジュールを挿入して以下を貼り付け
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
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

お礼

初心者の私には少しむづかしくてどのようにしていいのか解りませんでした。ありがとうございましたこれからもよろしくお願いします。

回答No.1

shkwta

単に欠番無しの順位を求めたいだけなら、これでどうですか。
(1)Ａ列とＢ列の２行目から下を、成績の降順で並べ替えます。
(2)C1に0を入れます。
(3)C2に、次の式を入れます。=IF(B2=B1,C1,C1+1)
(4)C2を、C3から下に必要な数だけコピーします。

補足

=IF(B2=B1,C1,C1+1)エラーが出るセルと順位じゃないような一番目のセル以外はエラーまたは67(二桁の数字になりました）