電子書籍の厳選無料作品が豊富!

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

A 回答 (9件)

#3です。



> ただ、4月28日から5月7日までの長期連休時はに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
    • good
    • 1
この回答へのお礼

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

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

お礼日時:2006/12/10 21:04

こういうのを標準モジュールに貼り付けて


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日
・・・・・
としたら、Sheet1のB列のセルに =INDIRECT("C" & rotaNo($A$1,A1,4)) で
ズズーとコピペで名前が入ります。
    • good
    • 1

#3です。



> 例「1火(一日の火曜日)」
> 曜日=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
    • good
    • 0
この回答へのお礼

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

お礼日時:2006/12/08 18:56

No2です。

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

No2です。


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

Sub Macro1()

pp = 1  '1:A 2:B 3:C 4:D
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 = "A"
            Case Is = 2
                Sheets("カレンダー").Cells(gg, ii + 1).Value = "B"
            Case Is = 3
                Sheets("カレンダー").Cells(gg, ii + 1).Value = "C"
            Case Is = 4
                Sheets("カレンダー").Cells(gg, ii + 1).Value = "D"
        End Select
    Else
        Sheets("カレンダー").Cells(gg, ii + 1).Value = "" '休日はNull
    End If
    gg = gg + 1  '行Noのカウントアップ♪
Loop

End Sub

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

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

No.1です。


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
    • good
    • 0

データの持ち方等が不明瞭です。


「曜日」にはどんなデータが入るのでしょう?
「月」「火」のような文字列ですか?

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

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


#2さんへ

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

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

この回答への補足

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

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

補足日時:2006/12/07 18:09
    • good
    • 0

曜日ではなく列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 '1週目
________________Sheets("カレンダー").Cells(2, ii).Value = "A"
____________Case Is < 14 '2週目
________________Sheets("カレンダー").Cells(2, ii).Value = "B"
____________Case Is < 21 '3週目
________________Sheets("カレンダー").Cells(2, ii).Value = "C"
____________Case Is < 28 '4週目
________________Sheets("カレンダー").Cells(2, ii).Value = "D"
________End Select
____Else
________Sheets("カレンダー").Cells(2, ii).Value = "" '休日はNull
____End If
____ii = ii + 1 '列Noのカウントアップ♪
Loop

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

この回答への補足

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

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

補足日時:2006/12/07 18:34
    • good
    • 0

どううまくいかないのでしょうか。


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

この回答への補足

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

補足日時:2006/12/07 18:52
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています