全校リレーのメンバー作成ソフト

質問

全校リレーのメンバー作成ソフトがありましたら,ご紹介ください。エクセルのワークシートがあった洋に記憶しているのですが,ありますでしょうか。チーム分けを自動でするコンピュータが自動的に各チームの合計タイムがだいたい同じになるように割り振るようにしたいのです。
エクセルで作れればいいのですが,作り方も分かりません。
どなたかお教えいただければ幸甚です。

回答No.2

nishi6 · ベストアンサー

『全校リレーのメンバー』の意味に悩んでしまいました。
全校から選抜された選手の振り分け？または全生徒でのリレー？（家の子の幼稚園や小学校では後者だった）組み合わせで悩むのは全生徒でのリレーだろうけど何人くらい？

選手が３０～４０人くらいでも決定方法は色々あると思いますが、コードを書いてみました。
テンプレート等、回答が無かったら試してみて下さい。
総人数（最大？万人）、チーム数（最大60チーム）くらいは決定できると思います。常識の範囲内で動かしてみてください。
(500名、10チームをwindows95、Excel97で確認済み)

決定方法は、　生徒のデータをタイム別にソート　
　　　　　→　速いほうからチーム数分の生徒を選択
　　　　　→　選択した生徒をテキトー（乱数を使用）に各チームに振り分け
　　　　　→　最後まで繰り返し　　で行っています。

Sheet1のA1に『生徒の番号』、B1に『氏名』、C1に『タイム』の表題を入力します。
実際の生徒のデータを２行目から入力します。行は下方向に連続して入力してあることを条件にしています。

この入力データを、マクロでSheet2に指定した組数で振り分けます。
コード内の『組の数』に組み分けする数をセットして下さい。今は４組になっています。

ツール→マクロ→Visual Basic Editor でVBE画面に移り、挿入→標準モジュールで標準モジュールを挿入し、そこに下記コードを貼り付けます。
ワークシートに戻り、ツール→マクロ→マクロ→で『組分け』を実行します。

ここから
↓
Dim ws1 As Worksheet 'シート１＝データ入力（生徒番号、氏名、タイム）
Dim ws2 As Worksheet 'シート２＝クラス分け後の名簿
Const 組の数 = 4 '*** 組み分けする数 *** ここを指定！！
Const KMKnum = 3 'データ項目数（『生徒の番号』、『氏名』、『タイム』の３つ）

Sub 組分け()
　　Set ws1 = Worksheets("Sheet1")
　　Set ws2 = Worksheets("Sheet2")

　　Application.ScreenUpdating = False

　　'*** 出力シート(Sheet2)の表題を作成
　　Dim col As Integer, d As Integer '列カウンタ、カウンタ
　　ws2.Activate: ws2.Cells.ClearContents
　　For col = 1 To 組の数 '表題をクラス数分コピーする
　　　　For d = 1 To KMKnum
　　　　　　Cells(1, (col - 1) * (KMKnum + 1) + d) = ws1.Cells(1, d)
　　　　Next
　　Next

　　'*** タイム順に並べる(Sheet1)
　　ws1.Activate: Range("A2").Select
　　Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, _
　　　　　　　　　 Key2:=Range("A2"), Order2:=xlAscending, Header:=xlGuess

　　'*** 生徒のタイムを『組の数』単位で読んで、ランダムに各組に振り分ける
　　Dim rw As Long '行カウンタ
　　Dim cc As Integer 'グループ分けする人数、人数カウンタ
　　Dim wrRow As Integer, wrCol As Integer '書き込む行、列

　　ws2.Activate: rw = 2: wrRow = 1
　　While ws1.Cells(rw, 1) <> ""
　　　　cc = cc + 1
　　　　If cc = 組の数 Then '組の数だけ生徒を選んだらグループ分けする
　　　　　　wrRow = wrRow + 1
　　　　　　振り分け wrRow, cc, rw
　　　　　　cc = 0
　　　　End If

　　　　rw = rw + 1
　　Wend
　　'残りの生徒をグループ分けする
　　wrRow = wrRow + 1: rw = rw - 1
　　振り分け wrRow, cc, rw

　　'*** 出力結果を生徒番号でソート
　　Dim sortCol As Integer
　　For col = 1 To 組の数
　　　　Cells(2, (col - 1) * (KMKnum + 1) + 1).Select
　　　　Selection.Sort Key1:=Cells(2, (col - 1) * (KMKnum + 1) + 1), _
　　　　　　　　　　　 Order1:=xlAscending, Header:=xlGuess
　　Next

　　'***生徒番号順の並びに戻す
　　ws1.Activate
　　Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
　　ws2.Activate: Range("A1").Select
　　Application.ScreenUpdating = True

End Sub

'*** 生徒をグループに振り分ける （引数：出力行、生徒数、元データの最終行）***
Sub 振り分け(wRw As Integer, wC As Integer, sR As Long)
　　Dim c As Integer, d As Integer 'カウンタ
　　Dim wcl As Integer '書き込む列
　　For c = 1 To wC
　　　　'場所を乱数で選び、そこが空いていたら書き込む。
　　　　wcl = Int(Rnd() * 組の数)
　　　　While Cells(wRw, wcl * (KMKnum + 1) + 1) <> ""
　　　　　　wcl = Int(Rnd() * 組の数)
　　　　Wend
　　　　For d = 1 To KMKnum
　　　　　　Cells(wRw, wcl * (KMKnum + 1) + d) = ws1.Cells(sR - c + 1, d)
　　　　Next
　　Next
End Sub

お礼

早速のお答えありがとうございました。私の腕ではマクロは難しいのですが、何とかやってみます。また分からなくなくなったら、お教えください。　gottii

回答No.1

popesyu

エクセルのソルバーという機能を使えば簡単に計算できます。これはアドインですので、普通にインストールしたのであれば、標準では入らないので追加インストールする必要があります。

でソルバー機能は利用すること自体はそんなに難しくないのですが、『目的セル』『変化させるセル』『制約条件』をどのように置くかということを考えることが難しいです。
条件を適当に入れ替えて色々やってみてください（笑　そのうち求める結果が返ってくることでしょう。

お礼

popesyu さんへ
ありがとうございました。
エクセルのソルバーという機能は初めて知りました。
初心者でも分かりますか不安ですが、がんばってみます。
何とかやってみます。また分からなくなくなったら、お教えください。　gottii