タイムマシーンがあったら、過去と未来どちらに行く?

Excelの関数かVBAでグループ分けする方法を教えてください(。-_-。)

(VBA初心者です)
ある人数を、人数、性別、年齢がそれぞれ平均になるようにランダムにグループ分け(10グループ)するにはどうすればいいでしょうか。
また、グループ分けした際に、前回、前々回とかぶってしまうのは5人までにとどめたいです。
(a列名前、b列年齢、c列性別、d列前回グループ名、e列前々回グループ名入っています)

手入力でグループをざっと分けてから平均値を見てちまちま調整していましたが、時間がかかります(ー ー;)また、名前固定の順番で並んでいるので上から順番にふっていくと毎回似たようなグループに…(ー ー;)
効率の良い方法があれば教えてください!よろしくお願いします;_;

A 回答 (3件)

No.2 の修正



下図の黄色の部分「最大人数」ではなく「最高年齢」です。
申し訳ございませんでした。
「Excelの関数かVBAでグループ分けす」の回答画像3
    • good
    • 0

とりあえず「グループをざっと分けて」の部分のみ作りました。


「前回、前々回とかぶってしまう」の判定はかなり重いのでやっていませんが乱数をうまく使っているので多分かぶりは少ないと思います。
グループ名は処理しやすいように番号にしています。
結果の平均値などがわかる様に下図のように G ~J列を使っています
コードは以下の様になります。標準モジュールへ
-------------------------------------------------------------------------------
Sub Sample()
Const グループ数 As Long = 10
Dim 平均人数 As Double
Dim 全人数 As Long
Dim 最高年齢 As Long
Dim グループ As Long
Dim 行 As Long
Dim 終 As Long
Randomize
Columns("E:E").Insert Shift:=xlToRight
終 = Cells(Rows.Count, 1).End(xlUp).Row
Range("H2:K" & 終).ClearContents
最高年齢 = Application.WorksheetFunction.Max(Range("B2:B" & 終))
For 行 = 2 To 終
Cells(行, 5).Value = 行
If Cells(行, 3).Value = "男" Then
Cells(行, 4).Value = 最高年齢 * 10 + Cells(行, 2).Value + Rnd()
Else
Cells(行, 4).Value = Cells(行, 2).Value + Rnd()
End If
Next
Cells.Sort _
Key1:=Range("D2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
For 行 = 2 To 終
グループ = グループ + 1
If グループ > グループ数 Then グループ = 1
Cells(行, 4).Value = グループ
Cells(グループ + 1, 8).Value = グループ
Cells(グループ + 1, 9).Value = Cells(グループ + 1, 9).Value + Cells(行, 2).Value
If Cells(行, 3).Value = "男" Then
Cells(グループ + 1, 10).Value = Cells(グループ + 1, 10).Value + 1
Else
Cells(グループ + 1, 11).Value = Cells(グループ + 1, 11).Value + 1
End If
Next
Cells.Sort _
Key1:=Range("E2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
Columns("E:E").Delete Shift:=xlToLeft
Columns("G:J").Sort _
Key1:=Range("G2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
For 行 = 2 To Cells(Rows.Count, 7).End(xlUp).Row
Cells(行, 8).Value = Cells(行, 8).Value / (Cells(行, 9).Value + Cells(行, 10).Value)
Next
End Sub
-------------------------------------------------------------------------------
※ グループ数は「Const グループ数 As Long = 10」を変更すれば簡単に変更出来ます。
※ 性別の欄は「男」か「女」にして下さい。他の文字は総て「女」として処理されます。
※ 振り分けの仕組みですが、各人に特別な数字を振った後、その番号でソートして上から順にグループに1人ごと振り分けていきます(1,11,21,…がグループ1、2,12,22,…がグループ2、のように振っていく)。そして元の順番に戻しています。
肝は特別な数字です。男ならば最大人数を10倍したものに年齢と0から1未満の乱数を足したもの、女ならば年齢に0から1未満の乱数を足したものです。こうやることによってそれぞれの項目が重なることがなくランダムにきれいに並びます。
※ 画面の表示更新を止めればもっと早くなりますが、動いているのが判ってこちらの方が良いと思います。
「Excelの関数かVBAでグループ分けす」の回答画像2
    • good
    • 0

なかなか面白そうな課題ですね



ちなみに以下どのように考えているか説明いただけますか?
① 全体の人数は何人位を想定していますか?
② 年齢の構成はどのような物を想定していますか?
③ 年齢の全体平均よりグループ平均の差はどの位許容して良いですか?
④ 男女の構成比はどのような物を想定していますか?
⑤ 全体の構成比とグループごとの構成比の差はどの位許容して良いですか?

なお表示方法ですが、A列名前、B列年齢、C列性別、D列今回グループ名、E列前回グループ名、F列前々回グループ名の方が良いと思うのですが、いかがでしょうか?
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


おすすめ情報