エクセルでどうすればできるでしょうか。

質問

4人の子供が水泳のメドレーリレーをします。↓のタイムがありますが誰がどの種目を泳げば最速のタイムになるでしょうか。と言うような計算をしたいのです。

　　　クロール　背泳　平泳ぎ　バタフライ　　　（単位、秒）
Ａ君　　１０　　１５　　２０　　１７
Ｂ君　　１５　　２０　　２５　　２３
Ｃ君　　１２　　１３　　２３　　２４
Ｄ君　　１１　　１４　　２０　　２２

たとえば、ＡＢＣＤの順で泳ぐと７５秒。ＤＣＢＡの順で泳ぐと６６秒になりますが。
どうでしょう・・・。

回答No.4

rukuku · ベストアンサー

はじめまして
rukukuと申します。

人数、種目数ともさほど多くないので、力業でいきます
考え方としては、

Sheet1に
A B C D
1 クロール 背泳 平泳ぎ バタフライ
2 Ａ君 10 15 20 17
3 Ｂ君 15 20 25 23
4 Ｃ君 12 13 23 24
5 Ｄ君 11 14 20 22

という元データがあるとき、

Sheet3に
A B C D
1 クロール 背泳 平泳ぎ バタフライ
2 Ａ君 1
3 Ｂ君 1
4 Ｃ君 1
5 Ｄ君 1

という表を作り
=SUMPRODUCT(Sheet1!B2:E5,Sheet3!B2:E5)
で合計タイムを求めます。
「１」のついた種目が各選手の出場種目となります。

　この「１」の位置を動かしていき、合計が最小になる
組み合わせを探せば、ご希望の結果が得られます。

　４種目に４人が出場するのなら、その組み合わせは
４×３×２×１＝２４通り、なので手動で組み合わせを
求めても、さほど大変ではないかと思います。

　これが４種目に５人から４人選んで出場となると、
５×４×３×２＝１２０通りとなり、手動では大変に
なってきます。こうなると、マクロやその他の方法を
使う方がよいかと思います。

以下がそのマクロの１例です

Sheet1に
A B C D
1 クロール 背泳 平泳ぎ バタフライ
2 Ａ君 10 15 20 17
3 Ｂ君 15 20 25 23
4 Ｃ君 12 13 23 24
5 Ｄ君 11 14 20 22
6 Ｅ君 13 17 24 21

とあるときに、
A B C D E F
1 クロール 背泳 平泳ぎ バタフライ
2 Ａ君 Ｂ君 Ｃ君 Ｄ君 75
3 Ａ君 Ｂ君 Ｃ君 Ｅ君 74
4 Ａ君 Ｂ君 Ｄ君 Ｃ君 74
5 Ａ君 Ｂ君 Ｄ君 Ｅ君 71
6 Ａ君 Ｂ君 Ｅ君 Ｃ君 78
…
という表が得られます。後はＦ列をキーに並べ替えを行う
と良いでしょう。
（４種目に４人ですと、種目数が変わったときや人数が変
わったときにどこを変えればいいのかが分かりにくいので
選手を５人にしました。）

　マクロを実行する前に、「Sheet1」「Sheet2」「Sheet3」
の３つのワークシートを用意してください。「Sheet2」
「Sheet3」はマクロが内容を消しますので空のものにしてく
ださい。新規のブックを使用すると安全です。
　ワークシートが用意できましたら、「Sheet1」に上の例の
ような表を作ってください。

マクロの使い方
　１）「ツール」－「マクロ」－「新しいマクロの記録」
　２）「マクロの記録」のダイアログボックスで「ＯＫ」
　３）「ツール」－「マクロ」－「記録終了」
　４）「ツール」－「マクロ」－「Visual Basic Editor」
　５）「Micirosoft Visual Basic」で「表示」－「コード」
　６）下のマクロのSub Macro2() ～ End Sub をコピー＆ぺースト
　７）Ｅｘｃｅｌに戻る
　８）「ツール」－「マクロ」－「マクロ」
　９）「Macro2」を選択して実行

Sub Macro2()
'初期設定
''変数の定義
Dim Swimmer(5) As Boolean '選手。すでに種目が決まっていると真(True)
'まだ決まっていなければ偽(False)
Dim i As Integer '種目１に出場する選手(の番号)
Dim j As Integer '種目２に出場する選手(の番号)
Dim k As Integer '種目３に出場する選手(の番号)
Dim l As Integer '種目４に出場する選手(の番号)
Dim r As Integer '出力する行番号
Dim Overlap As Boolean '重複の確認

''出力先のシートの初期化
Worksheets("Sheet2").Range("A1").EntireRow.EntireColumn.ClearContents
Worksheets("Sheet2").Range("A1") = Worksheets("Sheet1").Range("B1")
Worksheets("Sheet2").Range("B1") = Worksheets("Sheet1").Range("C1")
Worksheets("Sheet2").Range("C1") = Worksheets("Sheet1").Range("D1")
Worksheets("Sheet2").Range("D1") = Worksheets("Sheet1").Range("E1")
r = 1

''計算用のシートの初期化
Worksheets("Sheet3").Range("A1").EntireRow.EntireColumn.ClearContents
Worksheets("Sheet1").Range("A:A").Copy (Worksheets("Sheet3").Range("A1"))
Worksheets("Sheet1").Range("1:1").Copy (Worksheets("Sheet3").Range("A1"))

'組み合わせとその組み合わせのタイムを求める
For i = 1 To 5
For j = 1 To 5
For k = 1 To 5
For l = 1 To 5

'Swimmer(1)～Swimmer(5)を一旦すべてFalseに
Swimmer(1) = False
Swimmer(2) = False
Swimmer(3) = False
Swimmer(4) = False
Swimmer(5) = False
Overlap = False

'重複の確認
If Swimmer(i) = False Then Swimmer(i) = True Else Overlap = True
If Swimmer(j) = False Then Swimmer(j) = True Else Overlap = True
If Swimmer(k) = False Then Swimmer(k) = True Else Overlap = True
If Swimmer(l) = False Then Swimmer(l) = True Else Overlap = True

'重複がなければその組み合わせについて計算を実行し結果を出力
If Not Overlap = True _
Then
'計算シートへ記入
Worksheets("Sheet3").Range("B2:IV65536").ClearContents
Worksheets("Sheet3").Cells(i + 1, 2) = 1
Worksheets("Sheet3").Cells(j + 1, 3) = 1
Worksheets("Sheet3").Cells(k + 1, 4) = 1
Worksheets("Sheet3").Cells(l + 1, 5) = 1

'結果の出力
r = r + 1
Worksheets("Sheet2").Cells(r, 1) = Worksheets("Sheet1").Cells(i + 1, 1)
Worksheets("Sheet2").Cells(r, 2) = Worksheets("Sheet1").Cells(j + 1, 1)
Worksheets("Sheet2").Cells(r, 3) = Worksheets("Sheet1").Cells(k + 1, 1)
Worksheets("Sheet2").Cells(r, 4) = Worksheets("Sheet1").Cells(l + 1, 1)
Worksheets("Sheet2").Cells(r, 6) = WorksheetFunction. _
SumProduct(Worksheets("Sheet1").Range("B2:E6"), Worksheets("Sheet3").Range("B2:E6"))
End If
Next l
Next k
Next j
Next i

End Sub

　このマクロは、あらゆる組み合わせ（例えば全種目を
Ａ君に出場など）から出場種目が重複するものを除いた
組み合わせを出力します。
　人数、種目数が少ないので、このような単純な考え方
でも良いと思います。
　また、理解のしやさすさの点から、繰り返し処理で簡略
化できるところもそのままになっています。

　４人に変更するには
For i = 1 To 5
For j = 1 To 5
For k = 1 To 5
For l = 1 To 5
の「５」をすべて「４」にしてください。

　人数を増やす場合には、他にも変更する点があります。
減らす場合にはいまのままで構いません。

Dim Swimmer(5) As Boolean
の５を人数以上にしてください。
Swimmer(1) = False
Swimmer(2) = False
Swimmer(3) = False
Swimmer(4) = False
Swimmer(5) = False
を人数分に追加してください。

↓こちらで質問してみるのもよいかと思います。
http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi

お礼

あっりがとうございます。本当にありがとうございます。
わたくし、エクセルの「エ」位しか出来ない素人者でしたが、それでも十分理解できました。理解は出来てませんが、見事結果がでました。あのコピペには感動しました。「エクセル全くかじってません」と、補足説明出したつもりが出てなく、難解用語が出てきてどうしようかと思いましたが、大変わかりやすい説明に感服いたしました。

＞という表を作り
=SUMPRODUCT(Sheet1!B2:E5,Sheet3!B2:E5)
で合計タイムを求めます。
「１」のついた種目が各選手の出場種目となります。

↑の　 =SUMPRODUCT(Sheet1!B2:E5,Sheet3!B2:E5)
これすらも判らないのです。お恥ずかしい・・・。
しかし、マクロの意味もわからずに言われたとおりにやってみて出来たときにはビックリしました。
本当にありがとうございました。

回答No.6

imogasi

＃２で解答を入れた者ですが、そのアルゴリズムによる具体的なコーディング例を載せます。
何をしているかは、コーヂングの中のコメントを見てください。
要点は「各競技レコードをソートして、第１位が出場すれば良いのです。唯し、同一人が２種目で第１位を占めていることがあるので、次席と差の大きい方に出て、少ない方は次席を第１位に繰り上げる」ことです。
途中「ＳＴＯＰ」のＳｔａｔｅｍｅｎｔが入っていますが変化をシート上で確認し追えるようにしたものです。同記録の者がいる時の繰り上がりについて、まだ不完全ですが取りあえず載せます。
Ｓｈｅｅｔ２の第２行目に最終残った者が出場するのが一番記録が良いはず。この問題は最短時間経路やクリチカルパス問題と似ているような気がするのですが、説明は私の手におえない。結果は１２＋２０＋２０＋１７＝６９と出ました。演算スピードは他者より早いはず。
Sub test01()
shumoku = 4 '競技種目数　ク＋背＋平＋バタ
'------最終行数の取得
Sheets("sheet1").Select
e = Range("a1").CurrentRegion.Rows.Count
' MsgBox e
'-----名前の列のコピー
Columns(1).Select
Selection.Copy
For i = 1 To shumoku + 1
J = (i - 1) * 3 + 1
Sheets("Sheet2").Select
Columns(J).Select
ActiveSheet.Paste
Next i
'------競技記録タイムのコピー
For i = 2 To shumoku + 1
Sheets("sheet1").Select
Columns(i).Select
Selection.Copy
J = (i - 1) * 3 - 1
Sheets("Sheet2").Select
Columns(J).Select
ActiveSheet.Paste
Next i
'------競技記録タイムのソート
For i = 2 To shumoku * 3 Step 3
Range(Cells(1, i - 1), Cells(e, i + 1)).Select
Selection.Sort Key1:=Cells(1, i), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Next i
'------次順位の者との競技レコードの差分の計算
For i = 2 To shumoku * 3 Step 3
For J = 2 To e - 1
Cells(J, i + 1) = Cells(J + 1, i) - Cells(J, i)
Next J
Next i
'-------第１位の者で同一人はいないか
'------おれば第2位の者との差の大きい種目で出場さ　　　せる（残す）
'------第2位の者との差の小さい方の種目は第２位を　　　上行に繰り上げる
p01:
kuriageari = "n"
For i = 1 To shumoku * 3 Step 3
Name = Cells(2, i)
For J = i + 3 To shumoku * 3 Step 3
If Cells(2, J) = Name Then
If Cells(2, J + 2) >= Cells(2, i + 2) Then
Range(Cells(2, i), Cells(2, i + 2)).Select
Selection.Delete Shift:=xlUp
kuriageari = "y"
Else
Range(Cells(2, J), Cells(2, J + 2)).Select
Selection.Delete Shift:=xlUp
kuriageari = "y"
End If
Stop 'プロセス確認のため入れた
End If
Next J
Next i
'-----繰り上げ者がいるともう一度繰り返し
If kuriageari = "y" Then GoTo p01
End Sub

回答No.5

rukuku

下の部分の表が崩れてしまったので送信し直します
A B C D
1 クロール 背泳 平泳ぎ バタフライ
2 Ａ君 1
3 Ｂ君 1
4 Ｃ君 1
5 Ｄ君 1

　A 　　　B 　　　C 　　　D　　　　　E
1 　　　　クロール 背泳 平泳ぎ バタフライ
2 Ａ君 　　1
3 Ｂ君 　　　　　　　　1
4 Ｃ君 　　　　　　　　　　　1
5 Ｄ君 　　　　　　　　　　　　　　　　　1

参考URL：

http://cgi.fuji.ne.jp/~fj2094/cgi-bin1/wwwlng.cgi

回答No.3

psss

＞1の方の解答は、１つの種目に出ると、他の種目には出られないことを組み込んでないのではないでしょうか。

　いいえ。Ｆｏｒ～Ｎｅｘｔの開始値を考えて記述すれば、どちらでも組めますが？

回答No.2

imogasi

こう言うロジックになるのでしょうか。ちょっと難しくて。間違っていたらごめんなさい。批評をお願いします。
#1の方の解答は、１つの種目に出ると、他の種目には出られないことを組み込んでないのではないでしょうか。
（１）データの各列の前に名前の列を挿入する。
（２）データの各列の後に差分をいれる列を挿入する。
第２行で言うと
Ａ名前　Ｂクロ－ルデータ　Ｃ差分　Ｄ名前　Ｅ背泳データ　Ｆ差分　Ｇ名前　Ｈ平泳ぎデータ　Ｉ差分　Ｊ名前　Ｋバタフライデータ　Ｌ差分とする。
（３）Ａ列の名前をＤ，Ｇ、Ｊに複写する。
（４）ＡＢＣをＢ列で昇順ソートする。ＤＥＦ列もＥ列で、ＧＨＩもＨ列で　ＪＫＬもＫ列で昇順ソートする。
（５）すぐ上の行との差を計算し表示する。Ｂ３には＝Ｂ３－Ｂ２をいれ、Ｂ４，Ｂ５に複写する。Ｅ，Ｈ、Ｋ列も同じくする。　
－－－－
（６）一番上の第３行で差分の一番大きいＬ列のＡの５に注目してバタフライはＡの１７秒に出てもらう。Ａのデータの「組み」（ＪＫＬ）には色をつける。
他の種目には出れないから、色をつけて、以後はないものと考え為マークする。
（７）Ｃ，Ｆ，Ｉの第４行の１，１，３のうち一番大きい３に注目して、平泳ぎはＤの２０に出てもらう。Ｄのデータの組にはＡと違う色をつける。
（８）背泳は第１のＣが残っているので、１３秒で出てもらう。
（９）クロールは残るＢに１５秒で出てもらう。
合計＝１７＋２０＋１３＋１５＝６５が最小。
以下表がＯＫＷＥＢでは乱れると思いますがご免。$はスペースを示す。
クロール 背泳
Ａ Ｂ　　　　　Ｃ　　　　　　Ｄ　　　　　Ｅ　　　　　Ｆ
a 10 $ c 13 $
d 11 1 d 14 1
c 12 1 a 15 1
b 15 3 b 20 5

b 15 $ c 13 $
＜－選択
－－－－
平泳ぎ バタフライ
Ｇ　　　　　Ｈ　　　　　Ｉ　　　　　　Ｊ　　　　　　　Ｋ　　　　　Ｌ
a 20 $ a 17 $
d 20 0 d 22 5
c 23 3 b 23 1
b 25 2 c 24 1

d 20 $ a 17 $
＜－選択

回答No.1

psss

ＶＢＡの基本は判っているとして方法だけを説明します。
（実は休み中なので、手元にエクセルが動くマシンがない）

　配列変数を設定して、選手と種目の組み合わせでタイムを代入します。
　次に、選手毎に、４種目ですからＦｏｒ～Ｎｅｘｔを４重で組んで、各組み合わせの合計を出しつつ、ＩＦ文で比較、常に合計が小さいほうの、合計と配列変数の組み合わせを保存し、最後にその保存した結果を表示出来る様にすればいいと思います。

　実際、もっとスマートな計算方法もあるでしょうが、１００人程度までの選出であれば、問題ないでしょう。