エクセルで耐久レース結果の集計、順位づけをするには

質問

エクセル２００２でサーキットでの耐久レース結果の集計、順位づけをリアルタイムで実行するにはどうすれば良いでしょう？

サンプル
通過順カウント ゼッケン
1 35
2 64
3 89
4 48
5 85
6 8
7 30
8 71
9 2
10 21
11 10
12 64
13 35
14 89
15 85
16 48
17 8
18 30
19 71
20 2
21 21
22 10
23 64
24 35
25 89
26 85
27 48
28 8
29 30
30 2
31 71
32 10
33 21
34 64
35 35
36 89
37 48
38 8
39 85
40 30
41 2
42 10
43 21
44 71
45 64
46 35
47 89
48 8
49 85
50 48
51 30
52 2
53 10
54 21
55 71
56 64
57 35
58 89
59 8
60 48
61 85
62 30
63 2
64 10
65 21
66 64
67 71
68 35
69 89
70 8
71 48
72 85
73 30
74 2
75 10
76 64
77 21
78 71
79 35
80 89
81 8
82 48
83 85
84 30
85 64
86 2
87 10
88 21
89 71
90 35
91 89
92 8
93 48
94 64
95 30
96 85
97 2
98 10
99 21
100 35
101 71
102 89
103 8
104 48
105 64
106 30
107 85
108 2
109 10
110 21

欲しい結果
順位　ゼッケン　週回数
1 　　64 　　　11
2 　　35 　　　10
3 　　89　　　　10
4 　　8 　　　10
5 　　48 　　　10
6 　　30 　　　10
7 　　85 　　　10
8 　　2 　　　10
9 　　10 　　　10
10 　　21 　　　10
11 　　71 　　　9

こんな感じです。
通過順のゼッケンを入力するたびに自動計算されその時点での周回数と順位が出るようにしたいのです。
よろしくお願いします。

回答No.6

hige_082 · ベストアンサー

修正したいのね
＃４と置き換えて
条件は同じ

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Dim i As Long
Dim ii As Long
Range("F2", Range("H65536").End(xlUp)).ClearContents
For i = 2 To Range("b65536").End(xlUp).Row
For ii = 2 To Range("H65536").End(xlUp).Row + 1
If Cells(ii, 6).Value = Cells(i, 2).Value Or Cells(ii, 6).Value = "" Then
Cells(ii, 6).Value = Cells(i, 2).Value
Cells(ii, 7).Value = Cells(ii, 7).Value + 1
Cells(ii, 8).Value = Cells(i, 1).Value
Exit For
End If
Next ii
Next i
Range("F2", Range("H65536").End(xlUp)).Sort Key1:=Range("G2"), Order1:=xlDescending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End Sub

お礼

ありがとうございます。
ほぼ思い通りに動いています。
修正してもすぐに計算しなおされてますね。

回答No.7

hallo-2007

No2です。まだ、空いていたのでおまけです。
　A　　　　B　 　　　　　　C　　D
　　　　スタート時間
ゼッケン　タイム　　　　周回数
と準備しておいて、C1にレースの開始時刻を入れておきます。
シートのコードには
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
GYOU = Range("A65536").End(xlUp).Row + 1
Cells(GYOU, 1).Value = Range("A1").Value
Cells(GYOU, 2).Value = Time - Range("C1").Value
Cells(GYOU, 3).Formula = "=COUNTIF(A3:A" & GYOU & ", A" & GYOU & ")"
Cells(GYOU, 4).Formula = "=IF(COUNTIF(A" & (GYOU + 1) & ":A$65536,A" & GYOU & ")=0,C" & GYOU & "-B" & GYOU & ","""")"
Range("A1").Activate
End If
End Sub
をコピィしてみてください。
通過時に、A1セルにゼッケン番号をいれると、上から順にゼッケン番号とラップが入ります。
回数と順位を計算するC、D列は関数が入りますので、修正の場合は　A列とB列を訂正してください。
順位を出す式は、空いている列に
=INDEX(A:A,MATCH(LARGE(D:D,ROW(A1)),D:D,FALSE))
と入れて下へコピィしておいてください。
ゼッケンごとのラップタイムがでるので
オートフィルターでゼッケンごとのタイムとか周回ごとの順位とかもすぐに表示できると思います。

お礼

ありがとうございます。しかし、データの集計に時刻の情報はないのです。
通過順序のみで判断しています。もちろんダミーの時刻を入れれば済む事なのですが知らない人がみたら紛らわしくなると思います。
それと、やはりマクロを使うと敷居が高くなり、後々の改良・修正の事や他の人が使うかもしれない事を考えると出来るだけ簡単なマクロかワークシート関数だけで処理出来る方が都合が良いのでもっとマクロを勉強してからチャレンジしてみたいと思います。
結局、通過順と周回数に重み付けしたものを判断基準にしてシートを完成させました。
みなさまのおかげで今回はワークシート関数だけで動くものを作れましたので終わりにしたいと思います。

回答No.5

noname#99913

No.1です。すみません。E列の式が間違っていました。次のようにしてください。

E2の式：=RANK(D2,D:D)

お礼

総合ポイント＝周回数*10000-ポイント（通過順位の加算）
という形で解決させました。
余りスマートとは言えないですが今は時間がないのでこれでやりたいと思います。
ありがとうございました。

補足

さっそくありがとうございます。
実は私もここで困っている訳ですが
このポイントの使い方をすると順位が正しく出ません。
１．周回が多い方が順位が上
２．同じ周回ならポイントが少ない方が順位が上（通過順が早い）
なんです
それがうまくクリア出来れば問題なく出来るのですが・・・

回答No.4

hige_082

マクロで良いなら
詳細が無いので、勝手に決めた
入力側
Ａ列：通過順カウント（必ず連番で、少し多めに入れといて）
Ｂ列：ゼッケン（半角数字で）
結果側
Ｅ列：順位
Ｆ列：ゼッケン
Ｇ列：週回数
Ｈ列：通過順
Ａ列、Ｅ列に連番を入力して、Ｂ列にゼッケンを入力するだけ

'対象ワークシートモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
If Not IsNumeric(Target.Value) Then Exit Sub
Dim i As Long
i = 0
Do
i = i + 1
If Cells(i, 6).Value = Target.Value Or Cells(i, 6).Value = "" Then
Cells(i, 6).Value = Target.Value
Cells(i, 7).Value = Cells(i, 7).Value + 1
Cells(i, 8).Value = Target.Offset(0, -1).Value
Exit Do
End If
Loop
Range("F2", Range("H65536").End(xlUp)).Sort Key1:=Range("G2"), Order1:=xlDescending, Key2:=Range("H2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End Sub

アレンジはご自分で
マクロが分らなければ無視してください

お礼

ありがとうございます。

回答No.3

hallo-2007

No2です。
　A　　　　　B　　　 C　　　　D　　　E　
ゼッケン　　通過時刻　回数　作業列　順位　ゼッケン　回数
1　　　　　　　　　　　　　　　　　　　１
2　　　　　　　　　　　　　　　　　　　２
3　　　　　　　　　　　　　　　　　　　３
として
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
Target.Offset(0, 1).Value = Time
Target.Offset(0, 2).Value = Target.Offset(0, 2).Value + 1
End If
End Sub
D列に　=C2ーB2　下コピィにしておけば
手修正も可能では。
回数が同じ場合の順位を確定するためにはどうして時間の情報が必要ですす。

お礼

ありがとうございます。
修正案についてはよく理解出来ず手に負えません。
いろいろありがとうございました。

回答No.2

hallo-2007

順位を決めるのに通過時間が必要ではないでしょうか？仮に
　A　　　　　B　　　 C　　　　D　　　E　
ゼッケン　　作業列　順位　ゼッケン　回数
1　　　　　　　　　　　　１
2　　　　　　　　　　　　２
3　　　　　　　　　　　　３
4
5
6
7
8
9
・・・と準備しておきます。
シートの名前のタブを右クリックして、コードの表示をクリック　VBエディターを開きます。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
Target.Offset(0, 1).Value = Int(Target.Offset(0, 1).Value) + 2 - Time
End If
End Sub
をコピィして閉じます。
通過したときに、A列のゼッケン番号をダブルクリックすると、B列に妙な日付や時刻が入ります。
B列は、クリックした回数引く時間ですので、この値が大きいほうが順位で上になります。
ここの作業にはマクロを使用しますが、入力の作業を簡単に出来ます。
C列には、表示したい順位を数値で入れておきます。
D列には、=INDEX(A:A,MATCH(LARGE(B:B,C2),B:B,FALSE))
E列には、=INT(INDEX(B:B,MATCH(LARGE(B:B,C2),B:B,FALSE)))
といれて下へコピイしておけば、順位に応じたゼッケン番号とそのゼッケンの回数が表示されると思います。

お礼

ありがとうございます。こんなやり方があるとは知りませんでした。
シンプルで結構感動ものの回答です。
概ね、やりたい事に沿ってはいるのですが、入力ミスの修正方法や操作ミスを防ぐ手段を講じないといけないなど私にはハードルが高すぎて満足なものを完成出来そうにありません。
もう少し理解しやすいやり方を探してみたいと思います。

回答No.1

noname#99913

サンプルがA列、B列にあるとして、次のように入力してください。

Ｄ　　　　　　　　　　　　　Ｅ　　　　　　　　　　　　Ｆ　　　　　　Ｇ
ポイント　　　　　　　　　順位　　　　　　　　　　ゼッケン　　周回数
=SUMIF(B:B,F2,A:A)　=SUMIF(B:B,F2,A:A)　２　　　　　=COUNTIF(B:B,F2)
　　　　　　　　　　　　　　　　　　　　　　　　　　　　８
　　　　　　　　　　　　　　　　　　　　　　　　　　　　１０
（数式は下へコピー。ゼッケンは２～８９まで）

Ｉ　　　　Ｊ　　　　　　　　　　　　　　　　　　　Ｋ
順位　ゼッケン　　　　　　　　　　　　　　　周回数
１　　　=VLOOKUP(I2,E:G,2,FALSE)　　=VLOOKUP(I2,E:G,3,FALSE)
２
３
（順位は１～１１まで。数式は下へコピー）

お礼

お礼ではないのですが・・・
Ｅ列に順位が出ればその他は期待通りになるようです。
しかし、Ｅ列はＤ列と同じ数値が表示され順位が出ません。
何か間違ってますでしょうか？

補足

ありがとうございます。
コピペしてやってみてはいるのですがうまくいきません。
何か見落としてでもあるのでしょうか？引き続きやってみます。