重複しないグループ分けをエクセルで

質問

excel2010を使用しています。

１～９までを３つずつ３グループに分ける作業を４回行い、４回とも重複しないようにしたいのですが、エクセルの関数でうまく重複を避ける方法があるのでしょうか？

　　　　　　　　Ａグループ　Ｂグループ　Ｃグループ
１回目　　　　１－２－３　　４－５－６　　７－８－９
２回目　　　　１－４－７　　２－５－８　　３－６－９
３回目　　　　・・・
４回目　　　　・・・

のようにすべての回で重複しないようにしたいと思っています。
９つを３つずつ・・・は手書きでもなんとかなると思いますが
１～１２を４つずつ３グループに重複しないで・・・
１～１５を５つずつ３グループに重複しないで・・・
１～１８を６つずつ３グループに重複しないで・・・
というように応用したいと思いますので、ぜひエクセルの関数かＶＢＡのプログラムで作成できるようにしたいと思っていますが、どのような関数をどのように使えばいいのかわからず困っています。

どなたかご教授いただけないでしょうか。

回答No.3

mt2008 · ベストアンサー

1～9なら重複なし、12なら重複1まで、15なら重複2まで、…24なら重複6までOKとして作ってみました。
並び替えに乱数を使っている手抜き版ですが、取りあえず動きます。
数値をB2セル以降に入れています。

コードが長くなったのとあまりに手抜きで恥ずかしいので、細かい説明は省略します。

Public nGroupData()
Public nRow As Integer
Sub test()
　　Dim nTarget()
　　Dim nMax As Long
　　Dim nCount
　　ReDim nGroupData(11)

　　nRow = 1
　　'対象配列を作成
　　nMax = 9 '3で割り切れる数（9～24）。9以外にする場合はここを変更
　　ReDim nTarget(nMax - 1)
　　For i = 0 To (nMax - 1)
　　　　nTarget(i) = i + 1
　　Next i

　　nCount = 0
　　Do While nRow <= 4
　　　　'配列をシャッフル
　　　　nTarget = fShuffle(nTarget)

　　　　'配列に重複が無いか確認
　　　　If fChkTarget(nTarget) = True Then
　　　　　　'重複なしならシート上に反映
　　　　　　nTarget = fSortTarget(nTarget)
　　　　　　For i = 0 To (nMax - 1)
　　　　　　　　Cells(nRow + 1, i + 2) = nTarget(i)
　　　　　　Next i
　　　　　　nRow = nRow + 1
　　　　Else
　　　　　　nCount = nCount + 1
　　　　　　'乱数に頼っているので1000回やっても重複なしにならなかったらGiveUp
　　　　　　If nCount >= 1000 Then
　　　　　　　　MsgBox ("GiveUP!")
　　　　　　　　Exit Sub
　　　　　　End If
　　　　End If
　　Loop
End Sub

' 配列をシャッフル
Private Function fShuffle(list)
　　For i = 0 To UBound(list)
　　　　Randomize Second(Now())
　　　　nRn = Int(UBound(list) * Rnd)
　　　　nTmp = list(i)
　　　　list(i) = list(nRn)
　　　　list(nRn) = nTmp
　　Next i
　　fShuffle = list
End Function

'グループ内でソート
Private Function fSortTarget(nTarget)
　　Dim nGroup
　　Dim nGrCount As Long
　　Dim nWork(2)
　　nGrCount = (UBound(nTarget) + 1) / 3
　　For i = 0 To 2
　　　　nSwap = 1000
　　　　Do While nSwap <> 0
　　　　　　nSwap = 0
　　　　　　For j = (i * nGrCount) To ((i + 1) * nGrCount - 2) Step 2
　　　　　　　　If nTarget(j) > nTarget(j + 1) Then
　　　　　　　　　　nSwap = nTarget(j)
　　　　　　　　　　nTarget(j) = nTarget(j + 1)
　　　　　　　　　　nTarget(j + 1) = nSwap
　　　　　　　　End If
　　　　　　Next j
　　　　　　For j = (i * nGrCount + 1) To ((i + 1) * nGrCount - 2) Step 2
　　　　　　　　If nTarget(j) > nTarget(j + 1) Then
　　　　　　　　　　nSwap = nTarget(j)
　　　　　　　　　　nTarget(j) = nTarget(j + 1)
　　　　　　　　　　nTarget(j + 1) = nSwap
　　　　　　　　End If
　　　　　　Next j
　　　　Loop
　　　　nGroup = 0
　　Next i
　　fSortTarget = nTarget

End Function

'重複をチェック
Private Function fChkTarget(nTarget) As Boolean
　　Dim nWorkOne
　　Dim nGrCount As Long
　　Dim nWork(2), nChk, sChk
　　fChkTarget = False

　　nGrCount = (UBound(nTarget) + 1) / 3
　　For i = 0 To 2
　　　　nWorkOne = 0
　　　　For j = 1 To nGrCount
　　　　　　 nWorkOne = nWorkOne + 2 ^ (nTarget(i * nGrCount + j - 1) - 1)
　　　　Next j

　　　　'重複していない個数を確認
　　　　For k = 0 To ((nRow - 1) * 3 - 1)
　　　　　　'検査対象と、今までのグループのデータでxorを取る
　　　　　　nChk = (nWorkOne Xor nGroupData(k))
　　　　　　sChk = fDec2Bin(nChk) '01の2進数文字列(24文字）に変換
　　　　　　sChk = Replace(sChk, "0", "") '「0」を削除
　　　　　　'1の個数＝比較して重複していない個数
　　　　　　'1の個数が規定より少なければ重複と判断
　　　　　　If Len(sChk) < nGrCount Then Exit Function
　　　　Next k
　　　　nWork(i) = nWorkOne
　　Next i
　　For i = 0 To 2
　　　　nGroupData(3 * (nRow - 1) + i) = nWork(i)
　　Next i
　　fChkTarget = True
End Function

'10進数を2進数のStringに変換
Private Function fDec2Bin(nData) As String
　　'10進数を2進数のStringに変換（Max2＾24）
　　Dim nDataInt(2), i
　　Dim sAns As String

　　nDataInt(0) = Int(nData / (65536))
　　nDataInt(1) = Int((nData Mod 65536) / 256)
　　nDataInt(2) = nData Mod 256
　　For i = 0 To 2
　　　　sAns = sAns & Application.WorksheetFunction.Dec2Bin(nDataInt(i), 8)
　　Next i
　　fDec2Bin = sAns
End Function

お礼

回答ありがとうございました。

こんなに長いプログラムになるんですね。
こんなに長くなるとは思わず、軽はずみに
質問をしてしまったことを深く反省します。

わがままついでにもう一つ教えていただけないでしょうか。

１～１８を６つのグループに３つずつ重複なしで分けることは
可能でしょうか？

もし可能であればこのプログラムのどこを変更すればよいか
教えていただけると助かります。

大変申し訳ありませんがよろしくお願いします。

補足

補足です。

４回にこだわる必要はありません。
１０回、２０回でもいいので重複を避けられればと思います。

もう少し、プログラムの内容をよく読んでみます。

回答No.2

mt2008

> グループのメンバーは１名でもかぶらないようにしたいです。
> １－２－３と１－２－９は重複と判断します。

1～9を3つに分ける場合はこの条件で出来ますが、12以上の時はどうあがいても無理です。
条件を変更するか、1～9だけにするかにしてください。

お礼

回答ありがとうございます。

１２以上のときは無理なんですね。
考えるだけで嫌になってしまっていて可能かどうかは考えていませんでした。
適切なアドバイスありがとうございました。

回答No.1

mt2008

補足願います。

グループのメンバーは1名でもかぶっていたら駄目ですか？
つまり、1-2-3と1-2-9は重複ですか？重複ではないと判断しますか？

補足

回答ありがとうございます。

補足します。

グループのメンバーは１名でもかぶらないようにしたいです。
１－２－３と１－２－９は重複と判断します。

ＯＦＦＳＥＴやＩＦ、ＯＲなどを使いながら考えていますが
なかなかうまくできません。

何かいい方法があれば教えていただきたいと思います。

よろしくお願いします。