こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

VBA リーダーを選出したチーム分け

名簿を作り、その名前をランダムでチームに分けるようにしたいです。
検索して以下のようなVBAを作成しました。

※ チーム数は「TmCnt = 5」

Sub Sample()
Dim Total As Integer
Dim TmCnt As Integer
Dim Data1 As Variant
Dim Data2() As String
Dim i As Integer, j As Integer, k As Integer

Total = Cells(Rows.Count, 1).End(xlUp).Row
TmCnt = 5
Data1 = Range("A1:A" & Total).Value
ReDim Data2(1 To Total)
Randomize
For i = Total To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
i = 1
Do
For j = 1 To TmCnt
k = k + 1
Cells(i, j + 2).Value = Data2(k)
If k = Total Then Exit Sub
Next j
i = i + 1
Loop
End Sub

問題はA1~A5までの名前をランダムにリーダーとして各チームの1番目に配置する方法はどうしたら良いでしょうか?
宜しくお願いします。

投稿日時 - 2019-11-05 10:32:49

QNo.9675161

すぐに回答ほしいです

質問者が選んだベストアンサー

乱数作成ループの部分を入れ替えるです。

Sub Sample()
Dim Total As Integer
Dim TmCnt As Integer
Dim Data1 As Variant
Dim Data2() As String
Dim i As Integer, j As Integer, k As Integer

Total = Cells(Rows.Count, 1).End(xlUp).Row
TmCnt = 5
Data1 = Range("A1:A" & Total).Value
ReDim Data2(1 To Total)
Randomize

'↓入れ替え後
For i = TmCnt To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
For i = Total To TmCnt + 1 Step -1
j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1)
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
'↑ここまで入れ替えた

i = 1
Do
For j = 1 To TmCnt
k = k + 1
Cells(i, j + 2).Value = Data2(k)
If k = Total Then Exit Sub
Next j
i = i + 1
Loop
End Sub

投稿日時 - 2019-11-05 14:20:25

お礼

おかげさまでうまくできました。
ありがとうございました。

投稿日時 - 2019-11-05 14:54:23

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

> 「中断モードでコードを実行することはできません」とエラーが出ます

一時停止の状態で書き替えたのではありませんか。

投稿日時 - 2019-11-05 13:43:41

お礼

Sub Sample()

For i = TmCnt To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
For i = Total To TmCnt + 1 Step -1
j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1)
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i

End Sub

で合ってるでしょうか?

投稿日時 - 2019-11-05 13:59:39

ANo.3

For i = Total To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i

を先の回答部分と変更するということです。

投稿日時 - 2019-11-05 12:30:23

お礼

回答部分と変更しましたところ
「中断モードでコードを実行することはできません」とエラーが出ます。

投稿日時 - 2019-11-05 13:13:37

ANo.2

画像やVBAコードをコピペする前に、文章で正確に表現するべき。
これが、頭の整理、条件の整理とコード作成のために必須と考える。
これに基づいて、処理ステップを文章で箇条書きに(分解)して、VBAコード化を考える。
ーー
コードを書く前に、「処理ロジック」を決めないとならない。これでVBAコードが決まり、コード行数の多少や誤りの多少に結び付く。
 ベテランなら質問する(聞く)必要がないわけで、初心者のコードなどを質問に出ても仕方がないと思わない?
ーー
下記の件は質問で説明しているか?
グループ分け(グループ所属)もランダムにしたいのか?
チームのリーダー選出基準はどうなのか?
ーー
処理提案例の1つ。
5グループの仕分けは、B列などに、1-5までの乱数をエクセル関数で振り、そのデータを固定し(式を消す)、その数字でソートすれば仕舞いだろう。
VBAなどいらぬ。これを1,2、・・の数でフィルタ機能で、抜き出したらよい.マクロの記録でこの操作をコード化できなくもないと思うが。
リーダーは1番上の行のものにするのか。こんなことはふつうやらないと思うが。この質問例が本当は別の件で、思い付きの件か?
ーー
手間暇かけて、回答を頼むのだから、Test1などとしないで、佐藤・・などとして、直感的に、人を指していることが、わかるように、例をあげたらどう?

投稿日時 - 2019-11-05 12:00:04

お礼

説明不足ですみません。
実はこれはサーフィンのヒート組み合わせです。
A1~5はAランクのサーファー
それ以外はBランクサーファーです。
Aランクサーファーが一緒にならないようにしたいのです。

投稿日時 - 2019-11-05 13:15:39

ANo.1

単純な方法としてランダム作成のループを2回に分けたらいかがでしょう

For i = TmCnt To 1 Step -1
j = Int(Rnd * i) + 1
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i
For i = Total To TmCnt + 1 Step -1
j = Int((i - (TmCnt + 1) + 1) * Rnd + TmCnt + 1)
Data2(i) = Data1(j, 1)
Data1(j, 1) = Data1(i, 1)
Next i

投稿日時 - 2019-11-05 11:22:50

お礼

回答をありがとうございます。
現にあるVBAプログラムに追加するということで合ってますか?
結果は変わりませんでした。

投稿日時 - 2019-11-05 11:57:09

あなたにオススメの質問