エクセルで重ならないようランダムに並び替え

質問

ある担当者表です。

Ａ　名前　名前　名前
　　名前　名前　名前
―――――――――
Ｂ　名前　名前　名前
　　名前　名前　名前
―――――――――
Ｃ　名前　名前　名前
　　名前　名前　名前

上記の様に職員Ａ・Ｂ・Ｃにそれぞれ複数列で横に名前データが入っています。
それを同じ職員が同じ名前データにならないよう、ランダムで並び替えが出来る計算式はあるでしょうか？

毎月手作業で並び替えていて大変です。
ぜひお力をお貸しください。

回答No.5

Nouble

コードを乗せていきます。

Option　Explicit
Option　Base　0
Const　Base　=　0　_
　　　　,　人数　=　18　_
　　　　,　表示行数　=　6　_
　　　　,　従業員記載列数　=　1　_
　　　　,　縦表示開始位置　=　3　_
　　　　,　横表示開始位置　=　5
Const　ファーストNo.　=　Base　+　1　_
　　　　,　Eof　=　Base　-　1　_
　　　　,　右手　=　Base　+　1　_
　　　　,　左手　=　Base　+　2　_
　　　　,　実態　=　Base　+　0
Const　触手数　=　3　+　Base　-　ファーストNo.

Function　間乱数(ByVal　Val1　As　Long,　ByVal　Val2　As　Long)　As　Long
　　　　間乱数　=　Evaluate("RANDBETWEEN("　&　Val1　&　","　&　Val2　&　")")
End　Function

Function　方形数(ByVal　Val1　As　Long,　ByVal　Val2　As　Long)　As　Long
　　　　方形数　=　Evaluate("Ceiling("　&　Val1　&　","　&　Val2　&　")")
End　Function

Function　方形辺(ByVal　Val1　As　Long,　ByVal　Val2　As　Long)　As　Long
　　　　方形辺　=　方形数(Val1,　Val2)　/　Val2　　　　　'
End　Function

Function　桁上り(ByVal　Val1　As　Long,　ByVal　Val2　As　Long)　As　Long
　　　　桁上り　=　Fix(CDbl(Val1)　/　CDbl(Val2))
End　Function

Sub　Main()
Dim　ポインタ1　As　Long,　カウンタ1　As　Long,　カウンタ2　As　Long,　ターゲット　As　Long,　総データ量　As　Long
Dim　データ残量　As　Long,　メッセージ　As　String,　BadEnd　As　Boolean,　名前リスト　As　Range,　輪留め　As　Long
Dim　実データ()　As　String,　データリンク()　As　Long,　スプール()　As　String,　このブック　As　Workbook,　しーと　As　String
　　　　BadEnd　=　False
　　　　Set　このブック　=　ThisWorkbook
　　　　しーと　=　ThisCell.Worksheet.Name
　　　　メッセージ　=　"正常終了"
　　　　Set　名前リスト　=　このブック.Sheets(しーと).Range("A3").CurrentRegion.Resize(,　従業員記載列数)
　　　　If　名前リスト.Count　<　人数　_
　　　　Then
　　　　　　　　メッセージ　=　"職員名簿に不備があります"
　　　　　　　　BadEnd　=　True
　　　　Else
　　　　　　　　総データ量　=　名前リスト.Count
　　　　　　　　輪留め　=　総データ量　+　1
　　　　　　　　ReDim　実データ(ファーストNo.　To　Base　+　総データ量)
　　　　　　　　ReDim　データリンク(Base　To　Base　+　触手数,　Base　To　Base　+　輪留め)
　　　　　　　　ReDim　スプール(ファーストNo.　To　Base　+　方形数(人数,　表示行数))
　　　　　　　　For　カウンタ1　=　ファーストNo.　To　総データ量
　　　　　　　　　　　　実データ(カウンタ1)　=　CStr(名前リスト(カウンタ1).Value)
　　　　　　　　　　　　データリンク(実態,　カウンタ1)　=　カウンタ1
　　　　　　　　　　　　データリンク(右手,　カウンタ1)　=　カウンタ1　+　1
　　　　　　　　　　　　データリンク(左手,　カウンタ1)　=　カウンタ1　-　1
　　　　　　　　Next　カウンタ1
　　　　　　　　データリンク(右手,　輪留め)　=　Eof
　　　　　　　　データリンク(実態,　輪留め)　=　Eof
　　　　　　　　データリンク(右手,　Base)　=　ファーストNo.
　　　　　　　　データ残量　=　総データ量
　　　　　　　　For　カウンタ2　=　ファーストNo.　To　人数
　　　　　　　　　　　　ターゲット　=　間乱数(1,　データ残量)
'　　　　　　　　　　　　Debug.Print　データ残量　&　"　"　&　ターゲット　&　"　"　&　カウンタ3
　　　　　　　　　　　　カウンタ1　=　Base
　　　　　　　　　　　　ポインタ1　=　Base
　　　　　　　　　　　　Do
　　　　　　　　　　　　　　　　ポインタ1　=　データリンク(右手,　ポインタ1)
　　　　　　　　　　　　　　　　カウンタ1　=　カウンタ1　+　1
　　　　　　　　　　　　　　　　If　データリンク(右手,　ポインタ1)　<=　Eof　Or　カウンタ1　>　データ残量　_
　　　　　　　　　　　　　　　　　　　　　　　　Or　データリンク(右手,　Base)　<=　Eof　Or　データ残量　<　1　_
　　　　　　　　　　　　　　　　Then
　　　　　　　　　　　　　　　　　　　　BadEnd　=　True
　　　　　　　　　　　　　　　　End　If
　　　　　　　　　　　　Loop　Until　カウンタ1　>=　ターゲット　Or　BadEnd
　　　　　　　　　　　　If　Not　BadEnd　_
　　　　　　　　　　　　Then
'メンバを取り出しリンクから外す。
'　　　データを読出した後に、
'　　　ポインタメンバー左手側のメンバーの右手に、ポインタメンバーの右手側のメンバーを掴ませ、
'　　　ポインタメンバー右手側のメンバーの左手に、ポインタメンバーの左手側のメンバーを掴ませ
'　　　リンケージを再構築する
　　　　　　　　　　　　　　　　If　実データ(データリンク(実態,　ポインタ1))　=　""　Then　MsgBox　("げ!!")
　　　　　　　　　　　　　　　　スプール(カウンタ2)　=　実データ(データリンク(実態,　ポインタ1))
　　　　　　　　　　　　　　　　データリンク(左手,　データリンク(右手,　ポインタ1))　=　データリンク(左手,　ポインタ1)
　　　　　　　　　　　　　　　　データリンク(右手,　データリンク(左手,　ポインタ1))　=　データリンク(右手,　ポインタ1)
　　　　　　　　　　　　　　　　データリンク(左手,　ポインタ1)　=　Eof
　　　　　　　　　　　　　　　　データリンク(右手,　ポインタ1)　=　Eof
　　　　　　　　　　　　　　　　データリンク(実態,　ポインタ1)　=　Eof
　　　　　　　　　　　　　　　　データ残量　=　データ残量　-　1
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　　　メッセージ　=　"BadEnd"
　　　　　　　　　　　　　　　　Exit　For
　　　　　　　　　　　　End　If
　　　　　　　　Next　カウンタ2
　　　　　　　　If　Not　BadEnd　_
　　　　　　　　Then
　　　　　　　　　　　　For　カウンタ1　=　ファーストNo.　To　方形数(人数,　表示行数)
　　　　　　　　　　　　　　　　このブック.Sheets(しーと).Cells　_
　　　　　　　　　　　　　　　　(縦表示開始位置　+　(カウンタ1　-　1)　Mod　表示行数　_
　　　　　　　　　　　　　　　　,　横表示開始位置　+　桁上り(カウンタ1　-　1,　表示行数)).Value　_
　　　　　　　　　　　　　　　　=　スプール(カウンタ1)
　　　　　　　　　　　　Next　カウンタ1
　　　　　　　　End　If
　　　　End　If
　　　　MsgBox　(メッセージ)
End　Sub

SpecialThanks
cj_mover　様
mt2008　　様

回答No.4

Nouble

お待たせしました、
関数式では、今一上手くいきませんでしたが
VBAでは上手くいきました。

1PPMの精度を、
と、考えたのですが
どうやら40時間位掛かりそうなので、
5000回回して確認しました。

まあもう2度と同じ名前が出ることはないでしょう…
そういう構造ですから。

コード公開すべきか考えたのですが、
まあいいでしょう。

使い方ですが
まず第1にお願いすべきは
ファイルを開く時に
マクロを有効化することに同意頂くことでしょう。

VBAが入っていることが前提ですので、
これは此方からではどうにも避けられません。

其方の設定次第では　問答無用で
「VBAをOK」
と、できるのですが、

これは私からお願いできることではありませんし、
お勧めできません。

次には
Ｂ列に何も書かないで欲しい
と、云うことです。
書いてしまうと
結果に空欄が出ます。

後は、
Ａ列に名簿を
縦に好きなだけ書いてください、
但し
重複すると、結果も重複しかねません。
氏名以外を書くと、それが選び出されかねません。
お気をつけを…

ファイルを
http://sdrv.ms/11Skw4K
に、置いておきました。
このままではＶＢＡが動きませんので
ダウンロードしてお使いください。

ダウンロード後、開くと
シート名「ＶＢＡ」に、ボタンらしきものが置いてあります。
「しゃっふろ」と書いてあります。

これを「ぽち」っとクリックすると
名簿の人数が足りていたら、その中から18名選び出して
一覧で表示してくれます。

ＶＢＥでみれるなら、
縦方向の折り返し幅も
法事開始位置も、選び出す人数も、名簿に使える列数も、
全て定数で設定しておりますので、
この辺りを無難な範囲で変えて頂くと
思いのままになると思います。

著作権を謳う程のものか解らないですが、
一様著作権は放棄しませんので、
定数を変える程度より以上の
改変や流用はお控えください。

まあシート名を変えたり、ブック名を変えたりする分には良いですけどね、

これを使えば
カードゲームでのカードのシャッフルなんてお手の物
名簿にカードの種類を書いて一覧にして、選び出す定数、1列に何件出すか、全部で何件出すか、
を変えれば、大凡どんなゲームでも札が撒けるでしょう。

そもそも
私が最初にこれを作ったのが
カードゲーム用のシャッフル&配布の一部、
それの非常に簡易版なのですから。

でも、
使っちゃやですよ。

お使い頂ける範囲は
・貴方限定、・この業務限定、・この用途限定です。
コードの構造を知ったからと云って、
それも使わないでくださいね、

使うのは
その質問をして、答えを得た時だけ
に、してくださいね。

振りを振っている訳じゃないですよ、
マジ駄目ですからね。

コードも書こうと思いましたが文字数足らず、　Ｏｒｚ

如何でしょうか？
お役に立てていたならば幸いです。

回答No.3

Nouble

質問させてください
愚問かも知れませんが、
挙げられている中では「名前」が１８回上がっているように思います。

質問からすると
１８名以上の人物が居て、その内の１８名が、一切被ることなく出現する。
と、云うことを目指されているのでしょうか？

ＶＢＡで実現できなくもないですが、私の力では時間が掛かりそうですね、

取りあえず関数式なら、もっと早くできそうなのですが、
反復計算になっても構わないでしょうか？

補足をお待ちしております。

回答No.2

MarcoRossiItaly

No.1 です。一つ大事なことを書き忘れたので、補足します。

RAND 関数は、再計算のたびに異なる値を返すので、その度に、名前の配置が入れ替わることになります。これを固定するには、G1:I6 のセル範囲をどこかに値複写してください。つまり、コピーして右クリックなどで貼り付けるときに、「形式を選択して貼り付け」で「値」を指定して OK します。

回答No.1

MarcoRossiItaly

K1:L18 のセル範囲に名簿がある場合。

C1　=rand()
G1　=vlookup(rank(c1,$C$1:$E$6),$K$1:$L$18,2,)

C1、G1 セルをコピーしそれぞれ C1:E6、G1:I6 に貼り付け、あるいはオートフィル。