Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


24979 / 76732 ←次へ | 前へ→

【57098】Re:数値データの加算方法について教えてください。
回答  さぶちゃん  - 08/7/24(木) 1:23 -

引用なし
パスワード
   ▼ponpon さん:
色々とアドバイスをありがとうございます。

説明不足で正しく伝わらず、申し訳ありません。
正確にお伝えするために、今までのサンプル的なデータでの話しではなく、以下にありのままのデータでのご説明とさせて頂きます。
一番最後に、この質問の元データとponponさんにご教授頂いたコードを含めたコードを記述してありますので宜しくお願いいたします。

A列に試験順、B列に氏名が予め人数分入力されている元データがあります。
1番目の試験者に対してC列からG列までの5項目の試験の得点が入力されたら、H列(1セル分)空けて隣のK列からO列まで(I列は試験順、J列は氏名)のセルに元データをコピーすると同時に色々な加工をする事にしました。このコピーする意味は元データはそのまま変えずに残しておきたいからです。
コピー先の加工とは、コピーと同時に得点データのKからOまでを左から順にK列:最高点、L列:中間点1、M列:中間点2:、N列:中間点3、O列:最小点となる様に並び替えをし、同時に最高点と最小点に色付けをし、更にP列に合計点も出すというものです。(得点データの中で最高点と中間点1、最小点と中間点3が同じ値の場合は並び替えてもA列とB列、D列とE列が同じ値となる場合があります。)
ここで合計点についてですが、最高点と最小点は省いた残りの3つの得点(中間点1・2・3)の合計としています。
この手順で一人ずつ処理を実行していき9人(この人数は仮にですが)分の合計点までの全ての処理が終了したらP列の合計点を降順(高得点順)に並び替えをして、その合計点の中にもし同点がいたらQ列にその同点の得点を表示するというところまで何とかコードは出来ました。(コードを実行するボタンなどはまだ未完成ですが。)

後は、Q列の同点に対して順位付けをする処理なのですが、まずQ列の得点にN列の点数を加算して合計点の高い方が上位となる様にします。しかし、それで優劣が付かない場合は次に、同じ様にQ列にL列を加算して優劣を付けます。それでも優劣が付かない時は、最後に初めに省いたK列の最高点とO列の最小点の合計をQ列に加算して順位付けをするという手順にしたいのです。(これでも優劣が付かない場合は最終的に同点とします。)
この同点に対する処理は一括処理ではなく、3つのステップを踏んで一つずつ処理したいと思っています。
優先順位としてはN列>L列>K列+O列となるでしょうか。

上述した同点の部分をQ列に表示するという所から先のコードについてはどの様にしたら良いかまだ知恵が浮かびません。
以下に元データとQ列に表示させるところまでのコードを記述しました。
尚、参考までに私のエクセルのバージョンはExcel2002です。
この後の希望としては、Q列の同点に対し、上述した同点の処理により、R列に3行目と4行目の行の並び替えと、同じ様に7、8,9行目の同点に対し、同じ処理方法によりR列に9行目が上位となる様に並び替えし、更に7行目と8行目に対し、L列を加算しますが、優劣が付かないため、最後としてK列とO列の合計点をP列に加算すると7行目の方が高得点となりS列に7行目が上位となる様に表示出来る様なコードを作成する事です。
この通りに処理が出来たとすると最終的な順位としては、行で表示すると下記の様になると思います。(左から降順)

2  3  5  4  6  7  10  8  9

可能であれば最後のS列に最終的な形として1行目から9行目まで上記の同点の処理後の合計点が高い順(降順)に並び替えされた形で表示が出来ればありがたいのですが。
長々と書いて申し訳ありませんが宜しくお願いいたします。

(元データ)
 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") = "中間点1"
Range("M1") = "中間点2"
Range("N1") = "中間点3"
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

0 hits

【57070】数値データの加算方法について教えてください。 さぶちゃん 08/7/22(火) 2:11 質問
【57072】Re:数値データの加算方法について教えてく... ハチ 08/7/22(火) 9:13 発言
【57081】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/23(水) 1:18 質問
【57083】Re:数値データの加算方法について教えてく... ハチ 08/7/23(水) 9:20 発言
【57097】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/24(木) 1:12 回答
【57099】Re:数値データの加算方法について教えてく... ハチ 08/7/24(木) 11:40 発言
【57111】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/25(金) 0:15 回答
【57073】Re:数値データの加算方法について教えてく... ponpon 08/7/22(火) 9:24 発言
【57082】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/23(水) 1:19 質問
【57084】Re:数値データの加算方法について教えてく... ponpon 08/7/23(水) 9:43 発言
【57098】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/24(木) 1:23 回答
【57106】Re:数値データの加算方法について教えてく... Yuki 08/7/24(木) 17:15 発言
【57109】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/24(木) 21:30 回答
【57112】Re:数値データの加算方法について教えてく... Yuki 08/7/25(金) 7:20 発言
【57121】Re:数値データの加算方法について教えてく... さぶちゃん 08/7/26(土) 0:02 質問
【57122】Re:数値データの加算方法について教えてく... Yuki 08/7/26(土) 8:05 発言
【57117】Re:数値データの加算方法について教えてく... ponpon 08/7/25(金) 13:17 発言

24979 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free