マクロで当番表

質問

Excelマクロで当番表を作成しているのですが、わからない事があるのでお教えください。
例えば１週間毎にＡさん、Ｂさん、Ｃさん、Ｄさん４人を振り分けたいのですが、分岐、判断方法がわかりません。
１年間のカレンダーは出来上がっています。
当方の企業は完全週休２日で祝祭日も休みです。カレンダーの休日にはセルを塗りつぶしています。（マクロで34の薄い水色です。）
そこで、休日セルの塗りつぶしを背景で、日曜日～土曜日までを曜日で情報を受け取り作成したいのですが、うまくいきません。
月曜から金曜までをＡさん、次の週の月曜から金曜までをＢさんにしたいのです。
また、Ｄさんが終わればＡさんに戻る。
下記は曜日と背景の例です。
if then ElseでもDo until loopでも他の方法でもよろしいのでお教えください。
曜日=Right(Sheets("カレンダー").Cells(行, 列).Value, 1)
背景 = Cells(行, 曜日列).Interior.ColorIndex

回答No.9

papayuka · ベストアンサー

#3です。

> ただ、４月２８日から５月７日までの長期連休時はにBさんが抜けます。
> また、myList = Array("Aさん", "Bさん", "Cさん", "Dさん")で人数が変わってもよいのでしょうか？

1週間以上の休みを想定してませんでしたので、人数変更と合わせて修正してみました。

Sub Test2()
Dim r As Range, myList, i As Integer, j As Integer, flg As Integer
i = 0: flg = 0

For j = 2 To 24 Step 2
　　ActiveSheet.Columns(j).ClearContents
Next j

myList = Array("Aさん", "Bさん", "Cさん", "Dさん", "Eさん")
For j = 1 To 24 Step 2
　With ActiveSheet

　　For Each r In .Range(.Cells(2, j), .Cells(65536, j).End(xlUp))
　　　　If Weekday(r, vbMonday) <= 5 Then
　　　　　If r.Interior.ColorIndex <> 34 Then
　　　　　　 r.Offset(0, 1) = myList(i): flg = flg + 1
　　　　　End If
　　　　Else
　　　　　If Weekday(r, vbMonday) = 7 And flg > 0 Then
　　　　　　 i = i + 1: flg = 0
　　　　　　 If i > UBound(myList) Then i = 0
　　　　　End If
　　　　End If
　　Next r
　End With
Next j
End Sub

お礼

早いご解答ありがとうございました。
早速、試してうまく動作しました。

これを元に私のマクロの勉強も弾みがつきます。
大変ありがとうございました。
また、わからない事がありましたらよろしくお願いします。

回答No.8

nicotinism

こういうのを標準モジュールに貼り付けて
Function Rota(sDay As Date, tDay As Date, rt As Long) As String
Dim c As Variant
　　'sDay　当番開始日
　　'tDay　判断日
　　'rt　　何人でローテーションか

　　Set c = Worksheets("祝日表").Range("a:a").Find( _
　　　　　　　　Format(tDay, "m月d日"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　'↑祝日表の書式と併せるため
　　If Not c Is Nothing Then 'Find で条件に見合うものが有った場合
　　　　Rota = Trim(Str(rt + 3))
　　　　Exit Function
　　End If

　　Select Case Weekday(tDay, vbMonday)
　　　　Case 1 To 5
　　　　　　'週(7)で割った商を rt で割った余りを求めています
　　　　　　Rota = Str((DateDiff("d", sDay, tDay) \ 7) Mod rt + 1)
　　　　Case 6
　　　　　　Rota = Str(rt + 1)
　　　　Case 7
　　　　　　Rota = Str(rt + 2)
　　End Select
　　Rota = Trim(Rota)
End Function

ワークシートのセルに日付が入っているとしてB列に名前を出したい。
C列に当番者の名前がある。としたら
たとえば4人の例ですが
A1　12月1日 　　　B1　　　　C1 たなか
A2　12月2日 　　　B2　　　　C2 さとう
A3　12月3日 　　　B3　　　　C3 すずき
A4　12月4日 　　　B4　　　　C4 やまだ
A5　12月5日 　　　B5　　　　C5 土
A6　12月6日 　　　B6　　　　C6 日
A6　12月7日 　　　B7　　　　C7 祝
A6　12月8日 　　　B8　　　　C8
・・・・・・・・・・・・・・・

シートをもうひとつ用意して（上記モジュールではシート名を祝日表としています）
A列に年間の祝日の一覧を作成
A1　1月1日
A2　1月2日
A3　1月3日
・・・・・
としたら、Sheet１のB列のセルに =INDIRECT("C" & rotaNo($A$1,A1,4)) で
ズズーとコピペで名前が入ります。

回答No.7

papayuka

#3です。

> 例「１火（一日の火曜日）」
> 曜日=Right(Sheets("カレンダー").Cells(行, 曜日列).Value, 1)

Excelで日付を扱う場合、通常はこういうワープロ的な使い方をしません。
以下を新規ブックで試して下さい。

1）A2 に 2006/1/1　と入力
2）A3 に =A2+1　　 と入力
3）A3 を A32 までコピー
4）A2:A32を選択して、書式－セル－セルの書式設定で表示形式タブで分類を
「ユーザー定義」にして「種類」に　　daaa　　と入力します。

これで A2～A32 に 1日 ～ 31火 と表示されます。
A2 だけを 2007/1/1 に変えれば、あっという間に2007年1月のカレンダーになります。
表示形式によってセルに「2006/1/1」と入力したものを自在に表示出来るのです。
そして計算にも使えるようになりますし、条件付き書式で色付けも容易に出来ます。

yyyy/mm/dd (aaa)　　→　2006/01/01 (日)
yyyy/mm/dd (aaaa)　 →　2006/01/01 (日曜日)
gee/m/d (ddd)　　　 →　H18/1/1 (Sun)
(aaa)　　　　　　　 →　(日)

A2～W2に日付型でデータがある場合の例を私なりに書いてみました。

Sub Test1()
Dim r As Range, myList, i As Integer, j As Integer, flg As Boolean
i = 0: flg = False
myList = Array("Aさん", "Bさん", "Cさん", "Dさん")
For j = 1 To 24 Step 2
　With ActiveSheet
　　For Each r In .Range(.Cells(2, j), .Cells(65536, j).End(xlUp))
　　　　If Weekday(r, vbMonday) <= 5 Then
　　　　　If r.Interior.ColorIndex <> 34 Then
　　　　　　 r.Offset(0, 1) = myList(i): flg = True
　　　　　End If
　　　　Else
　　　　　If Weekday(r, vbMonday) = 7 And flg Then
　　　　　　 i = i + 1: If i > 3 Then i = 0
　　　　　End If
　　　　End If
　　Next r
　End With
Next j
End Sub

お礼

#3さん
Test1でうまくいきました。
ありがとうございます。
ただ、４月２８日から５月７日までの長期連休時はにBさんが抜けます。
勉強して解決したいと思います。
また、myList = Array("Aさん", "Bさん", "Cさん", "Dさん")で人数が変わってもよいのでしょうか？

回答No.6

noname#30052

No2です。追伸
　あ、もし配列がわかるなら配列にした方がすっきりしますよ。
　Selectなんか使わなくても済みますからね＾＾

回答No.5

noname#30052

No2です。
No1さんやNo3さんの言う通り、日付と曜日は分けたほうが
良いですよ。今後も楽になると思います。
でもどうしても今の形を壊したくない＆とにかく動きゃいいんだ
というのであれば。。。
No2のロジックをそのまま縦書きにしたバージョンを書いておきます。
（またしても動けばいいや状態ですがｗ）

Sub Macro1()

pp = 1　　'1:Ａ 2:Ｂ 3:Ｃ 4:Ｄ
For ii = 1 To 23 Step 2　　'ii:処理対象の欄No
　　　　Call Macro2(pp, ii)
Next ii

End Sub

Sub Macro2(pp, ii)

gg = 1 '行Noカウンタ（開始位置を設定）

' 曜日が設定されているところまで繰り返し実行～♪
Do
　　　　If Right(Sheets("カレンダー").Cells(gg, ii).Value, 1) = "" Then Exit Do
　　　　If Cells(gg, ii).Interior.ColorIndex <> 34 Then
　　　　　　　　If Right(Sheets("カレンダー").Cells(gg, ii).Value, 1) = "月" Then
　　　　　　　　　　　　If pp = 4 Then
　　　　　　　　　　　　 pp = 1
　　　　　　　　　　　　Else
　　　　　　　　　　　　 pp = pp + 1
　　　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　Select Case pp
　　　　　　　　　　　　Case Is = 1
　　　　　　　　　　　　　　　　Sheets("カレンダー").Cells(gg, ii + 1).Value = "Ａ"
　　　　　　　　　　　　Case Is = 2
　　　　　　　　　　　　　　　　Sheets("カレンダー").Cells(gg, ii + 1).Value = "Ｂ"
　　　　　　　　　　　　Case Is = 3
　　　　　　　　　　　　　　　　Sheets("カレンダー").Cells(gg, ii + 1).Value = "Ｃ"
　　　　　　　　　　　　Case Is = 4
　　　　　　　　　　　　　　　　Sheets("カレンダー").Cells(gg, ii + 1).Value = "Ｄ"
　　　　　　　　End Select
　　　　Else
　　　　　　　　Sheets("カレンダー").Cells(gg, ii + 1).Value = "" '休日はNull
　　　　End If
　　　　gg = gg + 1　　'行Noのカウントアップ♪
Loop

End Sub

VBAは本職じゃないので綺麗な命令にゃできませんが
その辺はご勘弁をｗ

No3さんへ
>私は投稿前にエディタで半角空白２個を全角空白１個に置換してからコピペしています。
了解です。ありがとうございます。

回答No.4

toshi_2000

Ｎｏ．１です。
A列に年月日、B列に背景でC列に当番を入れるマクロは、次の通りです。
これを元に変更して、月毎にFORループを分ければ、貴方のお望みのものができそうです。
Sub TEST()
Dim TN(4) As String
TN(1) = "A"
TN(2) = "B"
TN(3) = "C"
TN(4) = "D"
J = 0
For I = 1 To 365
If Weekday(Cells(I, 1)) > 1 And Weekday(Cells(I, 1)) < 7 And Cells(I, 2).Interior.ColorIndex <> 34 Then
If SHU > Weekday(Cells(I, 1)) Or Cells(I, 1) - DAY1 >= 7 Then
J = J + 1
If J = 5 Then
J = 1
End If
End If
Cells(I, 3) = TN(J)
SHU = Weekday(Cells(I, 1))
DAY1 = Cells(I, 1)
End If
Next
End Sub

回答No.3

papayuka

データの持ち方等が不明瞭です。
「曜日」にはどんなデータが入るのでしょう？
「月」「火」のような文字列ですか？

通常カレンダー等は日付（2006/12/1 等）を入力してセルの書式設定を　geee/mm/dd (aaa)　とか aaaa　とかにして処理をします。
そうする事で Weekday 関数で数値による条件判断が可能になります。

サンプルがほしいのであれば、データ構造を書かないと書けません。
現状のマクロもアップした方が良いかも。

#2さんへ

> ____は空白です。（投稿すると空白が勝手に詰まってしまうので。。(・_・;）

私は投稿前にエディタで半角空白２個を全角空白１個に置換してからコピペしています。
これでインデントは保持されます。
VBEエディタの場合なら、その状態でコピペしても半角空白に変換してくれますし、、、

補足

はじめに、訂正があります。
曜日=Right(Sheets("カレンダー").Cells(行, 列).Value, 1)
背景 = Cells(行, 曜日列).Interior.ColorIndex
　　　　　　　　　　　↓
曜日=Right(Sheets("カレンダー").Cells(行, 曜日列).Value, 1)
背景 = Cells(行, 列).Interior.ColorIndex

大変、舌足らずですみません。
A列に日付と曜日が入っています。例「１火（一日の火曜日）」
曜日列はA列のことをさしています
B列に当番表を作成したいのです。
要は、背景の塗りつぶしの色と曜日で判断したいのです。
よろしくお願いします。

回答No.2

noname#30052

曜日ではなく列Noで判断して設定してはいかがですか？
ざっと例を書くと。。。

ii = 1 '列Noカウンタ（開始位置を設定）
rr = 27 '調整値（27,0,1～5）

Do `曜日が設定されているところまで繰り返し実行～♪
____If Right(Sheets("カレンダー").Cells(1, ii).Value, 1) = "" Then Exit Do
____If Cells(1, ii).Interior.ColorIndex <> 34 Then
________Select Case (ii + rr) Mod 28 '列No÷4週（28日）の余り
____________Case Is < 7 '１週目
________________Sheets("カレンダー").Cells(2, ii).Value = "Ａ"
____________Case Is < 14 '２週目
________________Sheets("カレンダー").Cells(2, ii).Value = "Ｂ"
____________Case Is < 21 '３週目
________________Sheets("カレンダー").Cells(2, ii).Value = "Ｃ"
____________Case Is < 28 '４週目
________________Sheets("カレンダー").Cells(2, ii).Value = "Ｄ"
________End Select
____Else
________Sheets("カレンダー").Cells(2, ii).Value = "" '休日はNull
____End If
____ii = ii + 1 '列Noのカウントアップ♪
Loop

____は空白です。（投稿すると空白が勝手に詰まってしまうので。。(・_・;）
上記の例では曜日が１行目にあるものとし、２行目に担当者名を設定してます。iiとrrの初期設定値を調整すればうまく入ると思います。
ん～。。。即席なんであんまり綺麗なロジックじゃないですね～＾＾；
まぁ、あくまで１例として参考にして下さい☆
複数行に分かれてる場合は上記のようなｓｕｂルーチンを作って、開始行番号をパラメータで受け渡せば良いかと思います。
頑張ってください♪

補足

上記の例いちどやってみます。
ありがとうございます。

A.C.E.G.I.K.M.O.Q.S.U.W列に１日から２８日または３０日、３１日と入っています。(日付と曜日が同一セルに）
B.D.F.H.J.L.N.P.R.T.V.X列が空白セルです。
ここに当番者名を展開したいのです。
うまく言い表せませんがよろしくお願いします。

回答No.1

toshi_2000

どううまくいかないのでしょうか。
もう少し詳細を教えていただければ回答できるかも知れません。
Sheets("カレンダー"）の構造（どの列にどんなデータが入っているとか）

補足

#2さんの補足で説明したとおりですが、うまく説明ができません。
マクロをはじめてまだ、日が浅いのでお許しください。