For Eachを使った並び替えについて
XPのVBAで、シフトを組もうとしています。
登録者の中から5名を1組とし、班長を固定して4通り。
それを毎月、4組作成したいのです。
繰返しが多いので、簡単な方法がありそうなのですができません。
どうぞよろしくお願いいたします。
Sub 名簿()
Dim a As Range
‘名簿シートの1行目に=RAND()関数を入れる。2行目に名簿を作成する。
‘組合せシートの$AI$1, $AI$3, $AC$1, $AC$3の4つのセルに”組1”という名前を定義
‘名簿シートのB2セルの人を班長として固定。組合せシートの”組1”(4箇所)に貼り付ける
Sheets("名簿").Select
Range("B2").Select
Selection.Copy
Sheets("組合せ").Select
For Each a In Range("組1")
a.Select
ActiveSheet.Paste
Next a
‘名簿シートのC2セルから2行の最後までのデータをランダムに並べ替え、C2からF2をコピー、貼付け
For Each a In Range("組1")
a.Select
Selection.Offset(0, -4).Select
Sheets("名簿").Select
Range("C1:I2").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
Range("C2:F2").Copy
Sheets("組合せ").Select
ActiveSheet.Paste
Next a
‘名簿シートの全てのデータをランダムに並び替え。
Sheets("名簿").Select
Range("B1:I2").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End Sub
以上の作業を”組2”、”組3”、”組4”においても繰り返したいのです。
できれば、組の中で同じ組合せがないほうが嬉しいのですが。
できれば班長も同じ組が出来ないほうがよいのですが。
ややこしいお話で申し訳ありませんが、よろしくおお願いいたします。
お礼
わかりやすく簡潔な説明です。有難う御座います。