乱数処理を整数にまとめる場合、やっかいな問題があります。
「Rnd関数」は0以上、1未満の範囲の値を浮動小数点数型で返します。
今回のサンプルは、学校でよく行なわれる「席替え」です。添付のサンプルは40人学級ですが、人数の組み替えもできるようにしてあります。
浮動小数点数型の乱数を1～40の整数に変換させて取り出したいわけですが、問題なのは、40回乱数を発生させて整数に置き換えた段階で、以前に発生・変換した値とかなりダブってしまうことです。
もちろん、浮動小数点数の乱数値の段階では同じ値は採らないのでしょうが、整数にまるめた時点で同じ値になってしまうことが結構あるのです。
ここでは、そのダブりを取り除いてランダムな1～40の値を発生させる方法を2種類で説明してみます。 これが理解できれば、「席替え」の他にも、「忘年会の抽選」とか応用ができるでしょう。
ここでは、そのダブりを取り除いてランダムな1～40の値を発生させる方法を2種類で説明してみます。 これが理解できれば、「席替え」の他にも、「忘年会の抽選」とか応用ができるでしょう。
- まず、どのような動作なのか、マクロを動かしてみましょう。
-
このような「教室」をイメージしたシンプルがシート画面(座席表)です。
（この画像をクリックすると、2種類のサンプルExcelブックを収容した圧縮ファイルがダウンロードできます。）
さらに、この「教室」に在籍する生徒の出席番号と名前の一覧(在籍名簿)が別シートに用意してあります。
マクロは「教壇」をクリックさせると起動するようになっています。クリックすると、
このように、ランダムな順番に出席番号と名前が机の位置に並べられます。
もう一度、「教壇」をクリックすると、
当然、前回とは全く違う順番で出席番号と名前が机の位置に並べられます。
「オマケ」ですが、「黒板」をクリックすると、一度に全座席を表示するのではなく、1クリックに1人ずつ表示します。
- 「在籍名簿」の人数や、「机」の配置は任意に変更できます。
-
コードサンプルなのですが、場合によってはこのまま利用できるケースがあるかも知れません。
人数の増減や机の配置は、数の同期さえ取っていれば、自由に変更できるようにしてあります。
「在籍名簿」の方は空き行を作らずに出席番号と名前を並べてください。
「座席表」の「机」は、「在籍名簿」の人数と総数を合わせてあれば、配置は自由です。「机」はロックを解除したセルにして下さい。
シートの形やセルの色、罫線は全く自由で、ロックを解除したセルが「机」だと判断して処理されます。
なお、この処理ではセルの結合は行なわないで下さい。
- コードは、まずは、重複しない番号(整数)を見つけるまで、乱数を発生し直す方法です。
-
ここからが、マクロコードの説明ですが、マクロは２種類の方式を用意してみました。
最初は、以前に採番した番号を再度、乱数で採番してしまった場合、乱数の採番をやり直す方法です。
まず、コンパイルスイッチ(cnsTEST)ですが、値を「1」に変更すると、ランダム値を使わずに単に「在籍名簿」の並び順に配置されるようにしてあります。あまり、意味が無いかも知れませんが。'*************************************************************************************************** ' 「席替え」処理(乱数を使って再配置します。) Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '05/11/14(1.00)新規作成 '12/03/26(1.01)修正等 '20/03/02(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '=================================================================================================== ' テスト用スイッチ(1か0かを書き換えて動作させて下さい) #Const cnsTEST = 0 ' ← 1=テスト(出席番号順), 0=本番(乱数により席替え) '--------------------------------------------------------------------------------------------------- Public Const g_cnsSH1 As String = "座席表" Public Const g_cnsSH2 As String = "在籍名簿" Public Const g_cnsCntMidashi As Long = 1 ' 在籍名簿の見出し行数 '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：SEKIGAE '* 機能 ：「席替え」処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Sub SEKIGAE() '----------------------------------------------------------------------------------------------- Dim objSh1 As Worksheet ' 座席表シート Dim objSh2 As Worksheet ' 在籍名簿シート Dim objR As Range ' セル Dim lngRow As Long ' 行INDEX Dim lngRow2 As Long ' 行INDEX Dim lngRowMin As Long ' 名簿先頭行 Dim lngRowMax As Long ' 名簿最終行 Set objSh1 = ThisWorkbook.Worksheets(g_cnsSH1) Set objSh2 = ThisWorkbook.Worksheets(g_cnsSH2) '--------------------------------------------------------------------------- ' インデックス範囲と配列初期化 lngRowMin = g_cnsCntMidashi + 1 ' 在籍名簿シート With objSh2 ' フィルタ解除 If .FilterMode Then .ShowAllData ' 有効最終行の取得 lngRowMax = .Range("$A$" & .Rows.Count).End(xlUp).Row End With lngRow2 = lngRowMin '--------------------------------------------------------------------------- ' 乱数生成 Randomize ' 座席表シートの使用領域をループ For Each objR In objSh1.UsedRange ' 非ロックセルを対象とする(生徒の机) If Not objR.Locked Then ' ランダム番号発生 #If cnsTEST <> 1 Then lngRow = FP_GET_NO(lngRow2, lngRowMin, lngRowMax) #Else lngRow = lngRow2 #End If ' セルに出席番号と氏名をセット objR.Value = Format(objSh2.Cells(lngRow, 1).Value, "000") & vbLf & _ objSh2.Cells(lngRow, 2).Value ' 次の行へ lngRow2 = lngRow2 + 1 If lngRow2 > lngRowMax Then Exit For End If Next objR '--------------------------------------------------------------------------- ThisWorkbook.Saved = True ' 一応、上書き保存不要としておきます。 End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_GET_NO '* 機能 ：ランダム番号発生 '--------------------------------------------------------------------------------------------------- '* 返り値 ：生成したランダム番号(Long) '* 引数 ：Arg1 = 現在の生成位置(Long) ※実際は在籍名簿シートの現在行 '* Arg2 = 最小生成番号(Long) '* Arg3 = 最大生成番号(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Private Function FP_GET_NO(ByVal lngIx As Long, _ ByVal lngLowerBound As Long, _ ByVal lngUpperBound As Long) As Long '----------------------------------------------------------------------------------------------- Static tblNo() As Long ' 番号重複判定用配列(Static) Dim lngIx2 As Long ' テーブルINDEX(Work) Dim lngNo As Long ' 採番値 Dim blnSuccess As Boolean ' 採番成功判定 '--------------------------------------------------------------------------- ' 先頭INDEX値の場合は配列を作成(初期化) If lngIx = lngLowerBound Then ReDim tblNo(lngLowerBound To lngUpperBound) '--------------------------------------------------------------------------- ' 採番成功まで繰り返す Do Until blnSuccess ' 乱数の発生 lngNo = Int((lngUpperBound - lngLowerBound + 1) * Rnd + lngLowerBound) blnSuccess = True lngIx2 = lngLowerBound ' 念のため既に使った番号でないことを確認 Do While lngIx2 < lngIx ' 既に発番されている場合は再発番させる If tblNo(lngIx2) = lngNo Then blnSuccess = False Exit Do End If ' 次へ lngIx2 = lngIx2 + 1 Loop Loop '--------------------------------------------------------------------------- ' 採番値を返す tblNo(lngIx) = lngNo FP_GET_NO = lngNo End Function '----------------------------------------<< End of Source >>----------------------------------------
本処理では、「席替え処理(SEKIGAE)」の中のループ処理で、非ロックセルを見つけるたび、「ランダム番号発生処理(FP_GET_NO)」を呼び出します。 このため、ループ処理に入る前に「Randomizeステートメント」を発行しておいて、乱数ジェネレータを初期化しています。 これ以降に引数のない「Rnd関数」から取得する乱数は、少なくとも同じ乱数系列内で発行されることになります。
ですが、最初に説明した通り、「Rnd関数」から返される値は、「0」以上、「1」未満の単精度浮動小数点数(Single)型であり、整数の「1」から「40」の中で重複しないでランダムな順序で返してくれるわけではありません。
このため、「ランダム番号発生処理(FP_GET_NO)」では、初回に番号帯(このサンプルでは「在籍名簿」の行範囲)を要素数とする整数型の配列を用意しておいて、 採番する行をインデックスとして、整数にまるめたランダム採番値を配列に格納し、以降は配列の先頭行の位置から直前行の位置までに格納済みである採番値を検査して重複があるかどうかを確認し、 重複が見つかった場合はそのまま再度採番し直すように処理させています。
重複していない採番値が見つかった時点で、「席替え処理(SEKIGAE)」の方にランダム採番した番号が通知されるので、ループ処理側では、それを「在籍名簿」の行としてその行の出席番号と名前を「机」上に転記させているわけです。
「ランダム番号発生処理(FP_GET_NO)」では、何回も呼び出されるのに同じ配列で重複判定を行なうため、配列となる変数はStaticで宣言させています。 この処理では在籍名簿の人数と「机」の数が合っていることが前提となります。
- もう一つは、40回採番し配列に置いた浮動小数点数を昇順に並び替えて順番を決定する方法です。
-
こちらは、乱数を取得したら、浮動小数点数のまま配列に格納します。また、同じ要素数の配列には1から40の整数を順に並べておき、
後で、浮動小数点数の昇順に合わせて、配列を並べ替えます。
こちらの方法では、「ランダム番号発生処理(FP_GET_NO2)」はループ毎に呼び出すのではなく、ループに先だって1回だけ呼び出します。 「ランダム番号発生処理(FP_GET_NO2)」は、配列要素の先頭、最終番号を引数にして呼び出されると、その範囲の整数値を要素数の配列にランダムに並べ替えて返すようになっていますから、 受け取ってから、ループ処理では各要素の位置の番号をインデックス(ここでは行番号)にして出席番号、名前を取り出せば良いようになっています。'*************************************************************************************************** ' 「席替え」処理２(乱数を使って再配置します。) Module1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '05/11/14(1.00)新規作成 '12/03/26(1.01)修正等 '20/03/02(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '=================================================================================================== ' テスト用スイッチ(1か0かを書き換えて動作させて下さい) #Const cnsTEST = 0 ' ← 1=テスト(出席番号順), 0=本番(乱数により席替え) '--------------------------------------------------------------------------------------------------- Public Const g_cnsSH1 As String = "座席表" Public Const g_cnsSH2 As String = "在籍名簿" Public Const g_cnsCntMidashi As Long = 1 ' 在籍名簿の見出し行数 '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：SEKIGAE '* 機能 ：「席替え」処理 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Sub SEKIGAE() '----------------------------------------------------------------------------------------------- Dim objSh1 As Worksheet ' 座席表シート Dim objSh2 As Worksheet ' 在籍名簿シート Dim objR As Range ' セル Dim lngRow As Long ' 行INDEX Dim lngRow2 As Long ' 行INDEX Dim lngRowMin As Long ' 名簿先頭行 Dim lngRowMax As Long ' 名簿最終行 Dim tblRow As Variant ' 行番号テーブル Set objSh1 = ThisWorkbook.Worksheets(g_cnsSH1) Set objSh2 = ThisWorkbook.Worksheets(g_cnsSH2) '--------------------------------------------------------------------------- ' インデックス範囲と配列初期化 lngRowMin = g_cnsCntMidashi + 1 lngRowMax = objSh2.Range("A65536").End(xlUp).Row lngRow2 = lngRowMin '--------------------------------------------------------------------------- ' 並べ替え処理を呼び出す(配列で結果受け取り) tblRow = FP_GET_NO2(lngRowMin, lngRowMax) '--------------------------------------------------------------------------- ' 座席表シートの使用領域をループ For Each objR In objSh1.UsedRange ' 非ロックセルを対象とする If Not objR.Locked Then ' テーブルから行を受け取る #If cnsTEST <> 1 Then lngRow = tblRow(lngRow2) ' 乱数処理の結果の行 #Else lngRow = lngRow2 ' こちらは在籍表通り #End If ' セルに出席番号と氏名をセット objR.Value = Format(objSh2.Cells(lngRow, 1).Value, "000") & vbLf & _ objSh2.Cells(lngRow, 2).Value ' 次の行へ lngRow2 = lngRow2 + 1 If lngRow2 > lngRowMax Then Exit For End If Next objR '--------------------------------------------------------------------------- ThisWorkbook.Saved = True ' 一応、上書き保存不要としておきます。 End Sub '*************************************************************************************************** ' ■■■ サブ処理(Private) ■■■ '*************************************************************************************************** '* 処理名 ：FP_GET_NO2 '* 機能 ：ランダム番号発生２ '--------------------------------------------------------------------------------------------------- '* 返り値 ：生成したランダム番号テーブル(Array:Long⇒Variant) '* 引数 ：Arg1 = 最小生成番号(Long) '* Arg2 = 最大生成番号(Long) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明：LowerBoundからUpperBoundまでの要素の整数の配列を返す '* 注意事項： '*************************************************************************************************** Private Function FP_GET_NO2(lngLowerBound As Long, lngUpperBound As Long) As Variant '----------------------------------------------------------------------------------------------- Dim lngIx As Long ' テーブルINDEX Dim lngIx2 As Long ' テーブルINDEX Dim tmpNo As Long ' 並替えWORK Dim tmpSng As Single ' 並替えWORK Dim tblNo() As Long ' ランダム番号テーブル Dim tblSng() As Single ' 乱数テーブル '--------------------------------------------------------------------------- ' 配列を指定要素数で初期化 ReDim tblNo(lngLowerBound To lngUpperBound) ReDim tblSng(lngLowerBound To lngUpperBound) '--------------------------------------------------------------------------- ' 乱数生成 Randomize ' tblNoに整数の連番を設定,tblSngには乱数を設定 For lngIx = lngLowerBound To lngUpperBound tblNo(lngIx) = lngIx tblSng(lngIx) = Rnd() Next lngIx '--------------------------------------------------------------------------- ' バブルSORT(件数が少ないので) lngIx = lngLowerBound Do While lngIx < lngUpperBound lngIx2 = lngUpperBound Do While lngIx2 > lngIx If tblSng(lngIx2) < tblSng(lngIx) Then tmpSng = tblSng(lngIx) tblSng(lngIx) = tblSng(lngIx2) tblSng(lngIx2) = tmpSng tmpNo = tblNo(lngIx) tblNo(lngIx) = tblNo(lngIx2) tblNo(lngIx2) = tmpNo End If lngIx2 = lngIx2 - 1 Loop lngIx = lngIx + 1 Loop '--------------------------------------------------------------------------- ' 結果の配列(整数の方)を返す FP_GET_NO2 = tblNo End Function '----------------------------------------<< End of Source >>----------------------------------------
配列は、浮動小数点数と整数を「ユーザー定義型(Type)」にして並べ替えの転記回数を減らそうかとも思いましたが、 結局、最後には整数の配列だけを返すので配列の組み替えが発生します。似たようなものだったので「ユーザー定義型(Type)」は使わず、 浮動小数点数側の順序に合わせて、整数側も並び替えるように記述しました。
また、並べ替えも要素数がそれほど多くない処理なので、複雑に見えるクイックソートは使わず、コンパクトに記述できるバブルソートにしました。
やり方はこれだけではなく、トランプのシャッフルみたいに「40回」にこだわらずに配列内の数カ所を乱数で指して何回も入れ替えるなどの方法もあるようです。
このようなランダム処理のサンプルのひとつとして、ダウンロードに「パスワード自動生成機能」があるので、こちらも参考にしてみて下さい。
- 「黒板」の方のマクロは、上記に表示しませんでしたが、実際には上記のコードの次に記述しています。
-
これは、直前の説明の「ランダム番号発生処理(FP_GET_NO2)」を使う処理ですが、「席替え処理(SEKIGAE2)」そのものが「黒板」をクリックするたびに呼び出されて、
左上の机から順に1人分の出席番号と名前をセットして終わるように作られています。
ですが、毎回「ランダム番号発生処理(FP_GET_NO2)」を呼び出してしまうと、乱数系が変わってしまい、同じ人が再度登場してしまうことになるので、 乱数の発生や、机の配置を配列に確保する処理は先頭行の段階で行なって、行を保持する変数とともにStaticで宣言させて繰り返し呼び出されても 内容を保持できるようにした上で処理させています。
'*************************************************************************************************** '* 処理名 ：SEKIGAE2 '* 機能 ：「席替え」処理② ※ご参考に１机ごとに動作 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*************************************************************************************************** Sub SEKIGAE2() '----------------------------------------------------------------------------------------------- Dim objSh1 As Worksheet ' 座席表シート Dim objSh2 As Worksheet ' 在籍名簿シート Dim objR As Range ' セル Static lngRow2 As Long ' 行INDEX Static lngRowMin As Long ' 名簿先頭行 Static lngRowMax As Long ' 名簿最終行 Static tblR() As String ' セルアドレステーブル Static tblRow As Variant ' 行番号テーブル Dim lngRow As Long ' 行INDEX Set objSh1 = ThisWorkbook.Worksheets(g_cnsSH1) Set objSh2 = ThisWorkbook.Worksheets(g_cnsSH2) '--------------------------------------------------------------------------- ' インデックス範囲と配列初期化 If ((lngRow2 = 0) Or (lngRow2 > lngRowMax)) Then lngRowMin = g_cnsCntMidashi + 1 lngRowMax = objSh2.Range("A65536").End(xlUp).Row ReDim tblR(lngRowMin To lngRowMax) lngRow = lngRowMin ' 座席表シートの使用領域をループ For Each objR In objSh1.UsedRange ' 非ロックセルを対象とする If objR.Locked <> True Then If lngRow > lngRowMax Then ReDim Preserve tblR(lngRow) tblR(lngRow) = objR.Address objR.ClearContents lngRow = lngRow + 1 End If Next objR ' 並べ替え処理を呼び出す(配列で結果受け取り) tblRow = FP_GET_NO2(lngRowMin, lngRowMax) ' 先頭行をセット lngRow2 = lngRowMin End If '--------------------------------------------------------------------------- ' テーブルから行を受け取る #If cnsTEST <> 1 Then lngRow = tblRow(lngRow2) ' 乱数処理の結果の行 #Else lngRow = lngRow2 ' こちらは在籍表通り #End If '--------------------------------------------------------------------------- ' セルに出席番号と氏名をセット objSh1.Range(tblR(lngRowMin)).Value = _ Format(objSh2.Cells(lngRow, 1).Value, "000") & vbLf & _ objSh2.Cells(lngRow, 2).Value lngRow2 = lngRow2 + 1 '--------------------------------------------------------------------------- ThisWorkbook.Saved = True ' 一応、上書き保存不要としておきます。 End Sub
- 念のため、「在籍名簿」と「座席表」のロックを解除したセルの数が合うかの判定を用意しました。
-
これは、起動ボタンなどはないので、ツールバーの「マクロ」から起動させて下さい。
「在籍名簿」の人数と、「座席表」の非ロックセルの数を照合して、結果を表示してくれます。'*************************************************************************************************** ' 「席替え」処理(乱数を使って再配置します。) Module2(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** '変更日付 Rev 変更履歴内容------------------------------------------------------------------------> '05/11/14(1.00)新規作成 '12/03/26(1.01)初回修正 '20/03/02(1.10)*.xlsm化、他 '*************************************************************************************************** Option Explicit '*************************************************************************************************** ' ■■■ ワークシート側からの呼び出し処理 ■■■ '*************************************************************************************************** '* 処理名 ：非ロックセルの確認 '* 機能 ：非ロックセルの確認 '--------------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '--------------------------------------------------------------------------------------------------- '* 作成日 ：2005年11月14日 '* 作成者 ：井上 治 '* 更新日 ：2020年03月02日 '* 更新者 ：井上 治 '* 機能説明：在籍名簿人数と｢机｣の数が一致しているかの確認 '* 注意事項： '*************************************************************************************************** Sub 非ロックセルの確認() '----------------------------------------------------------------------------------------------- Dim objSh1 As Worksheet ' 座席表シート Dim objSh2 As Worksheet ' 在籍名簿シート Dim objR As Range ' セル Dim cntKensu1 As Long ' 座席表の非ロックセル数 Dim cntKensu2 As Long ' 在籍名簿の人数 Dim strRange As String ' セルアドレス Set objSh1 = ThisWorkbook.Worksheets(g_cnsSH1) Set objSh2 = ThisWorkbook.Worksheets(g_cnsSH2) '--------------------------------------------------------------------------- ' 在籍名簿シート With objSh2 ' フィルタ解除 If .FilterMode Then .ShowAllData ' 登録人数の取得 cntKensu2 = .Range("$A$" & .Rows.Count).End(xlUp).Row - g_cnsCntMidashi End With ' 座席表シートの使用領域をループ For Each objR In objSh1.UsedRange ' 非ロックセルを対象とする If Not objR.Locked Then cntKensu1 = cntKensu1 + 1 ' セルアドレスを追記 If strRange <> "" Then strRange = strRange & "," strRange = strRange & objR.Address End If Next objR ' 座席表シートを表示 If ActiveSheet.Name <> g_cnsSH1 Then objSh1.Activate objSh1.Range(strRange).Select '--------------------------------------------------------------------------- If cntKensu1 = cntKensu2 Then MsgBox """机""の数と在籍人数は合っています。", vbInformation Else MsgBox """机""の数と在籍人数が合っていません。" & vbCr & _ """机""の数=" & cntKensu1 & vbCr & _ "在籍人数=" & cntKensu2, vbExclamation End If objSh1.Range("$A$1").Select End Sub '----------------------------------------<< End of Source >>----------------------------------------