ランダムな席順に名前を入れる（後半）

マクロ講座80-その2回　
配列を使い、ランダムな席順に名前を入れる（後半）

ランダムな席順に名前を入れる Excel2013 マクロ講座 80回

ランダムな名前で席替え

ランダムな名前で席替えの後半です。
（サンプルファイルは、こちらからマクロ80回サンプルデータ）

配列に名前を格納する

こんどは、名前を1次元配列として格納してしまいましょう。配列に名前を格納することでコードがシンプルになります。
配列や変数を宣言したあとで、シートオブジェクトをセットし、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

実行すると、席順シートに名前が入力されます。
ランダムな席順に名前を入れるマクロ6

あとはコード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

お疲れ様でした。