関数でこんなの出来ますか？

質問

ランクとは違うのですが・・
【例】
５人が競争しました。その結果(勝率)がＢ列に入っています。
Ｃ列にＢ列の勝率に合わせた点数を入力したいのです。
点数は10ポイント制になります。
Ａ列　　Ｂ列　　Ｃ列
青木　　8.22
佐藤　　7.00
清水　　7.11
鈴木　　7.67
中村　　6.28
こんな計算が出来る関数とかありますか？
知っていましたら教えて下さい。
よろしくお願いします！

回答No.4

ham_kamo · ベストアンサー

マクロで作ってみました。かなり複雑になってしまいました^^;
ややこしそうだと思いますが、コピーして貼り付けるだけなので、以下に書いている手順通りに操作してみてください。

Excelの画面でAlt+F11を押すと、マクロの入力画面が開きます。そこで左側のツリーの「VBAProject(ブック名)」というところを右クリックし、「挿入」＞「標準モジュール」を選択すると、「Module1」というのができます。その状態で、右の画面に以下のマクロをコピーして貼り付けてください。

Function GetPoint(AllRatio As Variant, Ratio As Double) As Integer
　Dim MaxRatio As Double, Rank As Integer, MaxPoint As Integer
　Dim PrevRank As Integer, PrevRankRatio As Double, PrevPoint As Integer
　MaxRatio = Application.WorksheetFunction.Max(AllRatio)
　MaxPoint = IIf(MaxRatio >= 9, 10, 9)
　Rank = Application.WorksheetFunction.Rank(Ratio, AllRatio)
　If Rank = 1 Then
　　GetPoint = MaxPoint
　ElseIf MaxRatio - Ratio <= 0.5 Then
　　GetPoint = MaxPoint - (Ratio - 1)
　Else
　　PrevRank = GetPrevRank(AllRatio, Rank)
　　PrevRankRatio = GetRatio(AllRatio, PrevRank)
　　PrevPoint = GetPoint(AllRatio, PrevRankRatio)
　　If PrevRankRatio - Ratio <= 0.5 Then
　　　GetPoint = PrevPoint - 1
　　Else
　　　GetPoint = PrevPoint - 2
　　End If
　End If
End Function

Function GetPrevRank(AllRatio As Variant, Rank As Integer) As Integer
　Dim PrevRank As Integer, TmpRank As Integer, i As Integer
　PrevRank = 1
　For i = 1 To AllRatio.Count
　　TmpRank = Application.WorksheetFunction.Rank(AllRatio(i), AllRatio)
　　If TmpRank < Rank And PrevRank < TmpRank Then
　　　PrevRank = TmpRank
　　End If
　Next i
　GetPrevRank = PrevRank
End Function

Function GetRatio(AllRatio As Variant, Rank As Integer) As Double
　Dim i As Integer
　For i = 1 To AllRatio.Count
　　If Application.WorksheetFunction.Rank(AllRatio(i), AllRatio) = Rank Then
　　　GetRatio = AllRatio(i)
　　　Exit Function
　　End If
　Next
End Function

貼り付けたらマクロの画面は閉じてかまいません。

エクセルのシートに戻って、
C1に
=GetPoint($B$1:$B$5,$B1)
と入力し、それを下までコピーすると、各自の点数が表示されます。
正常な値にならない、エラーが出る場合などは補足をお願いします。

お礼

ありがとうございました！無事出来ました。
本当に感謝です。ありがとうございました。