| |
▼ハチ さん：
アドバイスありがとうございます。
>>高得点となるのでＡ３、Ａ４の行を入れ替えてＡ４の行が上になる様に
>>入れ替えた形でH列に表示します。
>
>再度、並び替え(sort)するということですか？
>行ごとに表全体を並び替えるのですよね？
はい、並び替えはしますが全体ではなく、Ｄ列を加算した結果、Ｈ列でＡ４の値の方がＡ３より大きくなるためＡ３とＡ４の２行のみ並び替えをします。(ゴメンなさい、Ｈ列の値の記述に誤りがありました。正しくはＡ３が29.8、Ａ４が29.9となります)
よって、Ｈ列は降順Ａ４(29.9)、Ａ３(29.8)の並びにしたいという事です。
>文章を読むと各列の重み(優先順位ですね）は、
>Ｆ＞Ｄ＞Ｂ＞Ａ＋Ｅ
>ということですかね？
説明不足で申し訳ありません。
正確にお伝えするために、今までのサンプル的なデータでの話しではなく、以下にありのままのデータでのご説明とさせて頂きます。
Ａ列に試験順、Ｂ列に氏名が予め人数分入力されている元データがあります。
１番目の試験者に対してＣ列からＧ列までの５項目の試験の得点が入力されたら、Ｈ列(１セル分)空けて隣のＫ列からＯ列まで(Ｉ列は試験順、Ｊ列は氏名)のセルに元データをコピーすると同時に色々な加工をする事にしました。このコピーする意味は元データはそのまま変えずに残しておきたいからです。
コピー先の加工とは、コピーと同時に得点データのＫからＯまでを左から順にＫ列：最高点、Ｌ列：中間点１、Ｍ列：中間点２：、Ｎ列：中間点３、Ｏ列：最小点となる様に並び替えをし、同時に最高点と最小点に色付けをし、更にＰ列に合計点も出すというものです。(得点データの中で最高点と中間点１、最小点と中間点３が同じ値の場合は並び替えてもＡ列とＢ列、Ｄ列とＥ列が同じ値となる場合があります。)
ここで合計点についてですが、最高点と最小点は省いた残りの３つの得点(中間点１・２・３)の合計としています。
この手順で一人ずつ処理を実行していき９人(この人数は仮にですが)分の合計点までの全ての処理が終了したらＰ列の合計点を降順(高得点順)に並び替えをして、その合計点の中にもし同点がいたらＱ列にその同点の得点を表示するというところまで何とかコードは出来ました。(コードを実行するボタンなどはまだ未完成ですが。)
後は、Ｑ列の同点に対して順位付けをする処理なのですが、まずＱ列の得点にＮ列の点数を加算して合計点の高い方が上位となる様にします。しかし、それで優劣が付かない場合は次に、同じ様にＱ列にＬ列を加算して優劣を付けます。それでも優劣が付かない時は、最後に初めに省いたＫ列の最高点とＯ列の最小点の合計をＱ列に加算して順位付けをするという手順にしたいのです。(これでも優劣が付かない場合は最終的に同点とします。)
この同点に対する処理は一括処理ではなく、３つのステップを踏んで一つずつ処理したいと思っています。
優先順位としてはＮ列>Ｌ列>Ｋ列＋Ｏ列となるでしょうか。
上述した同点の部分をＱ列に表示するという所から先のコードについてはどの様にしたら良いかまだ知恵が浮かびません。
以下に元データとＱ列に表示させるところまでのコードを記述しました。
尚、参考までに私のエクセルのバージョンはExcel2002です。
この後の希望としては、Ｑ列の同点に対し、上述した同点の処理により、Ｒ列に３行目と４行目の行の並び替えと、同じ様に７、８，９行目の同点に対し、同じ処理方法によりＲ列に９行目が上位となる様に並び替えし、更に７行目と８行目に対し、Ｌ列を加算しますが、優劣が付かないため、最後としてＫ列とＯ列の合計点をＰ列に加算すると７行目の方が高得点となりＳ列に７行目が上位となる様に表示出来る様なコードを作成する事です。
この通りに処理が出来たとすると最終的な順位としては、行で表示すると下記の様になると思います。(左から降順)
２ ３ ５ ４ ６ ７ １０ ８ ９
可能であれば最後のＳ列に最終的な形として１行目から９行目まで上記の同点の処理後の合計点が高い順(降順)に並び替えされた形で表示が出来ればありがたいのですが。
長々と書いて申し訳ありませんが宜しくお願いいたします。
(元データ)
A B C D E F G
No 氏名 点数 点数 点数 点数 点数
1 氏名 7.4 7.5 7.0 7.2 7.9
2 氏名 7.0 7.8 7.5 7.4 7.2
3 氏名 7.4 7.0 7.3 7.9 7.7
4 氏名 7.1 7.9 7.8 7.3 7.6
5 氏名 7.3 7.1 7.5 7.3 7.9
6 氏名 7.2 7.3 7.9 7.6 7.6
7 氏名 7.4 7.1 7.5 7.6 7.8
8 氏名 7.1 7.8 8.0 8.0 7.9
9 氏名 7.2 7.4 7.3 7.8 7.6
(コピー先)
I J K L M N O P Q
No 氏名 最高点 中間点1 中間点2 中間点3 最小点 合計
1 氏名 8.0 8.0 7.9 7.8 7.1 23.7
2 氏名 7.9 7.8 7.6 7.3 7.1 22.7
3 氏名 7.9 7.6 7.6 7.3 7.2 22.5 29.8
4 氏名 7.8 7.6 7.5 7.4 7.1 22.5 29.9
5 氏名 7.9 7.7 7.4 7.3 7.0 22.4
6 氏名 7.8 7.6 7.4 7.3 7.2 22.3
7 氏名 7.9 7.5 7.4 7.2 7.0 22.1 29.3
8 氏名 7.8 7.5 7.4 7.2 7.0 22.1 29.3
9 氏名 7.9 7.5 7.3 7.3 7.1 22.1 29.4
(コード)
Sub Macro1()
With Range("I1:P2").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("I1") = "試験順"
Range("J1") = "氏名"
Range("K1") = "最高点"
Range("L1") = "中間点１"
Range("M1") = "中間点２"
Range("N1") = "中間点３"
Range("O1") = "最小点"
Range("P1") = "合計点"
Range("A2:G2").Copy Range("I2:O2")
Range("K2:O2").Sort _
Key1:=Range("K2:O2"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K1:K2").Interior.ColorIndex = 8
Range("O1:O2").Interior.ColorIndex = 6
Range("P2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro2()
With Range("P3").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A3:G3").Copy Range("I3:O3")
Range("K3:O3").Sort _
Key1:=Range("K3:O3"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K3").Interior.ColorIndex = 8
Range("O3").Interior.ColorIndex = 6
Range("P3").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro3()
With Range("P4").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A4:G4").Copy Range("I4:O4")
Range("K4:O4").Sort _
Key1:=Range("K4:O4"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K4").Interior.ColorIndex = 8
Range("O4").Interior.ColorIndex = 6
Range("P4").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro4()
With Range("P5").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A5:G5").Copy Range("I5:O5")
Range("K5:O5").Sort _
Key1:=Range("K5:O5"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K5").Interior.ColorIndex = 8
Range("O5").Interior.ColorIndex = 6
Range("P5").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro5()
With Range("P6").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A6:G6").Copy Range("I6:O6")
Range("K6:O6").Sort _
Key1:=Range("K6:O6"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K6").Interior.ColorIndex = 8
Range("O6").Interior.ColorIndex = 6
Range("P6").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro6()
With Range("P7").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A7:G7").Copy Range("I7:O7")
Range("K7:O7").Sort _
Key1:=Range("K7:O7"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K7").Interior.ColorIndex = 8
Range("O7").Interior.ColorIndex = 6
Range("P7").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro7()
With Range("P8").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A8:G8").Copy Range("I8:O8")
Range("K8:O8").Sort _
Key1:=Range("K8:O8"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K8").Interior.ColorIndex = 8
Range("O8").Interior.ColorIndex = 6
Range("P8").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro8()
With Range("P9").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A9:G9").Copy Range("I9:O9")
Range("K9:O9").Sort _
Key1:=Range("K9:O9"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K9").Interior.ColorIndex = 8
Range("O9").Interior.ColorIndex = 6
Range("P9").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro9()
With Range("P10").Borders
.Weight = xlThin
.ColorIndex = 1
End With
Range("A10:G10").Copy Range("I10:O10")
Range("K10:O10").Sort _
Key1:=Range("K10:O10"), Order1:=xlDescending, Orientation:=xlSortRows
Range("K10").Interior.ColorIndex = 8
Range("O10").Interior.ColorIndex = 6
Range("P10").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-4]:RC[-2])"
End Sub
Sub Macro10()
Range("R7").Select
Application.Width = 750.75
Application.Height = 381.75
Columns("P:P").Select
Range("I1:P11").Sort Key1:=Range("P1"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
Range("L14").Select
End Sub
Sub Macro11()
Dim myR As Range
Set myR = Range("P1", Range("P" & Rows.Count).End(xlUp))
With myR.Offset(, 1)
.Formula = "=IF(COUNTIF(" & myR.Address & ",P1)>1,P1,"""")"
.Value = .Value
End With
End Sub
|
|
さぶちゃん
- 08/7/24(木) 1:12 -
