Excel VBAでランク上位から配分する方法

質問

たとえば、１位～５位までの順位を成績順に決めて、賞品３つ（商品の数は毎回変動する）を１つずつ上位から分けたいのですが、vbaで上記を行うにはどのように記述すればよいでしょうか。
イメージは、賞品の数が書いてあるセルがあり（上記の例では３）、そのセルの数値が０になるまで上位から分けていく、というものです。商品の数によっては当たらない人もいます。よろしくお願いします。

回答No.5

mt2008

補足拝見しましたが、VBAでやる必要性が感じられません。
関数で十分ではないでしょうか。
添付の図の例では、E2に賞品数を入れ、C2には↓の式を入れ下にコピーしています。
=IFERROR(IF($E$2>=RANK(B2,B:B),RANK(B2,B:B),""),"")

これで如何でしょう。

回答No.4

tom04

こんばんは！
VBAでの一例です。

↓の画像のような配置になっていて、「賞品数」はF2セルに入力済みとします。
C列順位（同順位なし）は操作しなくても良いようにコードに組み込みました。
（同順位の場合は上側が上位としています）

A・B列にデータがあるとします。

↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim i As Long, k As Long, cnt As Long, lastRow As Long
Dim c As Range, myAry
myAry = Array(1, 2, 3, 4, 5)
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
If lastRow > 1 Then
Range(Cells(2, "C"), Cells(lastRow, "D")).ClearContents
End If
Range(Cells(2, "C"), Cells(lastRow, "C")).Formula = "=COUNTIF(B:B,"">""&B2)+COUNTIF(B$2:B2,B2)"
0: For k = 0 To UBound(myAry)
Set c = Range("C:C").Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlWhole)
c.Offset(, 1) = c.Offset(, 1) + 1
cnt = cnt + 1
If cnt >= Range("F2") Then Exit For
Next k
If cnt < Range("F2") Then
GoTo 0
End If
End Sub

※　データ変更があるたびにマクロを実行してください。m(_ _)m

回答No.3

kkkkkm

VBAでなくてもRANK関数で順位を決めて、たとえば順位の入ったセルがB列で商品の数の入ったセルがE1だとして、C列に結果を表示するとした場合、C1に以下の式を入れて下にコピーすると商品数分の順位までの人に配分と表示されます。
=IF(AND(B1<>"",B1<=5,B1<=$E$1),"配分","")

RANK関数は使うとして
VBAだと以下のような感じでも
Sub Example()
Dim c As Range
Dim ItemsCount As Integer

If Range("E1").Value > 5 Then
ItemsCount = 5
Else
ItemsCount = Range("E1").Value
End If
Range("C:C").ClearContents
For Each c In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
If c.Value <> "" And c.Value <= Range("E1").Value And c.Value <= 5 Then
Range("C" & c.Row) = "配分"
ItemsCount = ItemsCount - 1
If ItemsCount = 0 Then
Exit For
End If
End If
Next
End Sub

回答No.2

keithin

Ａ１からＡ５セルに順位が記入してある
Ｄ１セルに賞品個数が記入してある

sub macro1()
range("B1:B5").formula = "=IF(A1<=SMALL(A:A,D$1),""○"","""")"
end sub

回答No.1

mt2008

補足願います。
同点等で同じ順位の人が複数いた場合はどうするのでしょう？
例：賞品3つ、１位：１名、２位：1名、３位；２名

補足

mt2008様、

ご回答ありがとうございます！

同点は発生しない前提で考えています。

質問では成績順と記載しましたが、
イメージとしては、同点が発生しないように乱数を発生させ、順位付けする。
そしてランキング上位から賞品を分配する。

分配する際のイメージは、a) 賞品5つ以下、1位～5位まで各1名、b)もしくは商品5つ以上、1位～5位まで各1名です。

賞品数分ループ分を回すようにして、賞品がある回数分処理を回して分配したいです。

つたない説明で申し訳ありません。