リスト内の名前をランダムに抽出する。

質問

シート１に下記のように14種類の名前リストがあります

　　　　A
1　　Ａさん
2　　Ｂさん
3　　Ｃさん
4　　Ｄさん
5　　Ｅさん
6　　Ｆさん
7　　Ｇさん
8　　Ｈさん
9　　Ｉさん
10　Ｊさん　
11　Ｋさん
12　Ｌさん
13　Ｍさん
14　Ｎさん

それを下記のように別ブックのシートの１４ブロックにランダムに重複しないように抽出したいのですが。

　　　　ブロック１　　　　　　　ブロック2　　　　　　　・・・・　　　　　　ブロック１４
　　　　A　　　　　B　　　　　　C　　　　　D　　　　　　　　　　　　　　AA 　AB
１　11月1日　　Ｃさん　　11月1日　　Ｍさん 　・・・・　　　　11月1日　　Ａさん

さらに2行目に同じ日付がきた場合には（ブロック１）上の行と同じ名前にする
他のブロックは重複なしでランダムに抽出。

　　　　ブロック１　　　　　　　ブロック2　　　　　　　・・・・　　　　　　ブロック１４
　　　　A　　　　　B　　　　　　C　　　　　D　　　　　　　　　　　　　　　AA 　　AB
１　11月1日　　Ｃさん　　11月1日　　Ｍさん　　　　・・・・　　　　　11月1日　　Ａさん
２　11月1日　　Ｃさん　　11月2日　　Ｅさん　　　　・・・・　　　　　11月2日　　Ｈさん

ちょっとややこしいので、毎回ランダムに重複しないように抽出できればいいのですが。

回答No.4

Wendy02

#3の回答者です。この質問の後のご質問者さんの質疑応答を読みました。
私は、VBAマクロ中心ですから、#3のような回答になりますが、数式のランダム出力とはまったく質的に異なるものです。バグがあれば別ですが、上の日付と同じ以外のものは、人名も上と同じものは出てこないようにできています。そういうことが重要でないなら、その後に出た関数方式でもよいのではないかと思います。

回答No.3

Wendy02

イメージは掴めました。試してみてください。1列目に日付がないとマクロは進みません。人名データはシート2、 日付表は、シート1になっています。現在はブロック14以下の場合でも、人名は空欄セルに吐き出します。14以上の場合、足らない場合は空欄になります。検査等のユーティリティも作っていますが、これが完成したら出します。

'//
Sub Test1()
　Dim colData As Collection
　Dim sh1 As Worksheet, sh2 As Worksheet
　Dim c As Variant
　Dim i As Long, j As Long, k As Long, m As Long, n As Long
　Dim mem As Long, iCnt As Long
　Dim rng As Range
　Set sh1 = Worksheets("Sheet1") '作成データ
　Set sh2 = Worksheets("Sheet2") '人名の入っているシート
　''人名シートは、A1から縦に入れること。
　Set colData = New Collection
　With sh2
　　Set rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
　　If rng.Rows.Count > 1 Then
　　For Each c In .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
　　　colData.Add c.Value
　　Next
　　Else
　　　MsgBox "人名データがないか、少なすぎます。", vbExclamation
　　　GoTo EndLine
　　End If
　End With
　iCnt = colData.Count
　mem = iCnt
　With sh1
　　m = .Cells(Rows.Count, 1).End(xlUp).Row
　　If VarType(.Cells(m, 1).Value) <> vbDate Then MsgBox "シートのデータがふさわしくありません。", 48: GoTo EndLine
　　If m > 1 Then
　　　For i = 1 To mem
　If .Cells(m - 1, i * 2 - 1).Value = .Cells(m, i * 2 - 1).Value Then
　　.Cells(m, i * 2).Value = .Cells(m - 1, i * 2).Value
　　n = 1
　　Do
　　　If colData.Item(n) = .Cells(m - 1, i * 2).Value Then
　　　　colData.Remove (n)
　　　End If
　　　n = n + 1
　　Loop Until n > colData.Count
　End If
　　　Next
　　End If
　End With
　iCnt = colData.Count
　mem = iCnt
　Randomize
　With sh1
　　k = 1 '列の初期値
　　Do
　　　j = Int(Rnd() * iCnt + 1)
　　　If m = 1 Then
　　　　.Cells(m, k * 2).Value = colData(j)
　　　　colData.Remove (j)
　　　　k = k + 1
　　　Else
　　　　If .Cells(m, k * 2).Value = "" Then
　　If (.Cells(m - 1, k * 2).Value <> colData(j)) Or colData.Count = 1 Then
　　　.Cells(m, k * 2).Value = colData(j)
　　　colData.Remove (j)
　　　k = k + 1
　　Else
　　　j = Int(Rnd() * iCnt + 1)
　　End If
　Else
　　k = k + 1
　　　　End If
　　　End If
　　　iCnt = colData.Count
　　Loop Until iCnt = 0
　End With
EndLine:
　Set sh1 = Nothing: Set sh2 = Nothing
End Sub

お礼

何度もありがとうございます。

参考にしてみます。

ただ、VBAはまだ使った事がないので勉強してみます。
回答内容はコピーしたので覚えていきたいと思います。
（エクセル2010の「マクロの記録」は使った事はあります）

お世話になりました。

回答No.2

Wendy02

補足質問です。

質問として、考え方のプロセスや仕組みが良く見えてこないのです。私が、最初に分からない部分は、「日付」の問題です。一体、どうやって日付が入れられるかということです。

そのプロセスを一気に飛び越えて、こうしてほしいと言われても、掲示板ではプロセスが分からないので、すぐには難しいのです。まず、日付が先にいれてあるということでしょうか？

#1さんの考え方は、正直、びっくりするような名アイデアだと思います。このまま捨ててしまうのはもったいないほどのアルゴリズムです。それを応用できるか出来ないか、それは運用する側にあると思います。

>2行目に同じ日付がきた場合には（ブロック１）上の行と同じ名前にする
>他のブロックは重複なしでランダムに抽出。

2番目の問題点は、その逆です。2行目というか、上の行のセルと違う日付の場合にも、ランダムですから、当然、上のセルと同じものが現れる可能性があるということになります。それを避けなくてはいけない、ということになりませんか？

そもそも、なぜ、同じ日付のセルが現れる意味が良く分からないです。同じ日付が14ブロック全部でしたら、全部、同じということになりますね。その上のセルと同じ日付は、一体、いくつ現れるかということです。

こちらで、1度作ってみましたが、かなりの確率で、違う日付で、上のセルと同じ名前が現れます。これを不可とする場合は、ランダムをやり直すシステムを途中で設けなくてはならないと思います。出来ないとは思えませんが、人間の頭でしてきたことを、マクロに移し替えるということは、考えているよりも難しいです。

補足

説明不足で本当に申し訳ありません。

本来のやりたい事の例えが難しく、日付抽出と名前抽出の二つに分けて、今回は名前の方の質問したのですが。
最終的にやりたいことは
例えば社用車が1号車から14号車まで14台あったとします。
使用者は一日に同じ車両しか使えません。
しかし基本的には翌日は違う車両を使わなくてはなりません。ただし、たまたま同じ車両を使っても良い事になっています。
でも、実際には使用者は毎日同じ車両を使っています。
また、それぞれに一日何か所も得意先に行く人もいれば行かない人もいます。
それを元に日報を書いているので同じ日付は14以上であったり以下であったりします。
14台の運行履歴を残すのに、行先や燃料代は実際のデータを使用し翌日は違う使用者になるように
ランダムに使用者を抽出（でっち上げ）したかったのです。

以上、説明不足かもしれませんが、不明な点は再度質問していただけましたらありがたいです。

回答No.1

noname#192382

下のプログラムはシート2の1列目に14こはいっている文字データをシート3の1列目にランダムに取り出すVBAです。
これを使ってみていただけませんか

Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2010/11/25 ユーザー名 :
'
Dim myno, kazu, mys3no As Integer
Dim myvalue As Variant
mys3no = 1
For kazu = 14 To 1 Step -1

myno = Int(kazu * Rnd() + 1)

myvalue = Cells(myno, 1)
Selection.Cut
Sheets("Sheet3").Select
Cells(mys3no, 1) = myvalue
Sheets("Sheet2").Select
Rows(myno).Select
Selection.Delete Shift:=xlUp
mys3no = mys3no + 1
Next

'
End Sub

お礼

説明不足で申し訳ありませんでしたが
抽出するセルは隣同士ではない任意のセルなので
ちょっと違うようです。

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