ランダムな席順に名前を入れる(後半)
マクロ講座80-その2回
ランダムな席順に名前を入れる Excel2013 マクロ講座 80回
ランダムな名前で席替え
ランダムな名前で席替えの後半です。
(サンプルファイルは、こちらから マクロ80回サンプルデータ)
配列に名前を格納する
こんどは、名前を1次元配列として格納してしまいましょう。
配列に名前を格納することでコードがシンプルになります。
配列や変数を宣言したあとで、シートオブジェクトをセットし、For~Nextで繰り返します。
配列や変数を宣言したあとで、シートオブジェクトをセットし、For~Nextで繰り返します。
With sheetobj3 For k = 1 To 40 mei(k) = .Cells(k + 1, 2) '順番に代入していく Next k End With
最後にsheetobj1に対して、前回同様、2重構造のFor文を使いセルの席順に名前を入れていきます。
k = 1 Set sheetobj1 = ThisWorkbook.Worksheets("sekijyun") With sheetobj1 For i = 1 To 8 For j = 1 To 5 .Cells(i, j).Value = mei(k) '机に見立てたセルに配列の番号を入れる k = k + 1 Next j Next i End With
実行すると、席順シートに名前が入力されます。
あとはコード1つにまとめます。
ランダムな名前で席替えのコードは次のようになりました。
ランダムな名前で席替えのコードは次のようになりました。
Public sheetobj1 As Worksheet 'ワークシートを代入するオブジェクト変数 Public sheetobj3 As Worksheet '〃 Sub 名前で席替え() Dim ra As Integer, k As Integer, i As Integer, j As Integer Dim mei(1 To 40) As String '生徒名を要素40個の配列にする Set sheetobj3 = ThisWorkbook.Worksheets("sekijyun3") Set sheetobj1 = ThisWorkbook.Worksheets("sekijyun") With sheetobj3 For ra = 2 To 41 '2行目から最終行まで .Cells(ra, 3).Value = Rnd '3列目に乱数を発生させる Next For ra = 2 To 41 '4列目に大きい順からの番号をつける .Cells(ra, 4).Value = WorksheetFunction.Rank(.Cells(ra, 3).Value, .Range("C2:C41"), 0) Next ra '並べ替え条件の設定 .Sort.SortFields.Clear 'With sheetobj3 .Sort.SortFields.Add Key:=Range("D2"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With With sheetobj3.Sort '並べ替えの実行 .SetRange Range("A1:D41") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With With sheetobj3 For k = 1 To 40 mei(k) = .Cells(k + 1, 2) '配列に名前を代入していく Next k End With k = 1 With sheetobj1 ' sheetobj1に対して、セルの席順に名前を入れる For i = 1 To 8 For j = 1 To 5 .Cells(i, j).Value = mei(k) '配列の名前を入れる k = k + 1 Next j Next i End With End Subお疲れ様でした。