![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_12.png?8acaa2e)
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
No.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
早いご解答ありがとうございました。
早速、試してうまく動作しました。
これを元に私のマクロの勉強も弾みがつきます。
大変ありがとうございました。
また、わからない事がありましたらよろしくお願いします。
No.8
- 回答日時:
こういうのを標準モジュールに貼り付けて
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)) で
ズズーとコピペで名前が入ります。
No.7
- 回答日時:
#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
#3さん
Test1でうまくいきました。
ありがとうございます。
ただ、4月28日から5月7日までの長期連休時はにBさんが抜けます。
勉強して解決したいと思います。
また、myList = Array("Aさん", "Bさん", "Cさん", "Dさん")で人数が変わってもよいのでしょうか?
No.5
- 回答日時:
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個に置換してからコピペしています。
了解です。ありがとうございます。
No.4
- 回答日時:
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
No.3
- 回答日時:
データの持ち方等が不明瞭です。
「曜日」にはどんなデータが入るのでしょう?
「月」「火」のような文字列ですか?
通常カレンダー等は日付(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列に当番表を作成したいのです。
要は、背景の塗りつぶしの色と曜日で判断したいのです。
よろしくお願いします。
No.2
- 回答日時:
曜日ではなく列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列が空白セルです。
ここに当番者名を展開したいのです。
うまく言い表せませんがよろしくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 祝日を除いた月曜から土曜までの1週間分の日付行を選択し、別シートへカットアンドペーストしたい 13 2023/07/13 22:46
- その他(Microsoft Office) 従業員増減対応で当番種類の増減対応な当番表 21 2022/07/19 07:30
- Excel(エクセル) Excelについて 1 2023/03/06 10:26
- Excel(エクセル) 添付写真上のExcelシートのように時間と曜日ごとに担当者が振り分けられているシートがあります。 例 1 2023/03/08 13:02
- 筋トレ・加圧トレーニング 筋トレで鍛える箇所について 4 2022/08/31 16:47
- Visual Basic(VBA) マクロ実行時、自動で背景色を変えたい。 C列にあるチェックボックスをチェックするとB列に「TRUE」 4 2022/11/08 11:14
- Excel(エクセル) エクセルでカレンダーを作りたい 5 2023/05/16 07:32
- ゴールデンウィーク・シルバーウィーク 何曜日が一番楽しいですか?私は、水曜日 1 2022/09/25 17:10
- その他(教育・科学・学問) 私の友人が課題提出を今日迄だと思っていたけれど大学が今日休みだと気付いてやばい!と連絡してきました。 3 2023/02/12 17:52
- 労働相談 夜勤の1週間シフトについて 月曜日の夜8時から朝の7時まで勤務します。 1週間のシフトが土曜日の朝で 3 2023/07/05 01:30
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
エクセルで少し複雑な当番表を作成したい。
Excel(エクセル)
-
エクセル 当番表の作り方 エクセルで土日祝日を除いた、平日のみの当番表を作りたいです。 カレンダーま
Excel(エクセル)
-
Excelで当番表の作成(休み考慮、完全ランダム)
Excel(エクセル)
-
-
4
Excelにて年間の当番表作成したい
Excel(エクセル)
-
5
エクセルの当番表を作っていますが教えてください
Excel(エクセル)
-
6
EXCEL 指定した曜日に番号を振って、最大値までいったら1に戻る当番表
Excel(エクセル)
-
7
エクセルで当番表を作成したいです。
Excel(エクセル)
-
8
従業員増減対応で当番種類の増減対応な当番表
その他(Microsoft Office)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
{ CONTROL Forms.Label.1}が...
-
テキストファイルの1行目のみを...
-
vba クリップボードクリアにつ...
-
Googleタグマネージャで、既存H...
-
Version Control on Unity
-
Processingについて
-
Python... 環境設定 初心者です...
-
そのまま使っただけなのに・・...
-
htaccessで特定のディレクトリ...
-
ExcelVBAでFormulaR1C1を列範囲...
-
Google ColaboでGUI作成
-
関数定義について質問です 架空...
-
フォルダを自動作成・移動を複...
-
ITパスポートの勉強をしていま...
-
バッチファイルが保存されてい...
-
P2P地震速報のEEW APIの仕様書...
-
Pythonについて。
-
JRのjsonファイルって使って大...
-
HTMLソースが表示のページのも...
-
PythonのTkinter詳しい方へ。画...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
vba クリップボードクリアにつ...
-
テキストファイルの1行目のみを...
-
Google ColaboでGUI作成
-
Python... 環境設定 初心者です...
-
AIの登場でプログラマーたちが...
-
入力された文字列が、LD22000を...
-
ITパスポートの勉強をしていま...
-
プログラミングサイトについて。
-
バッチファイルが保存されてい...
-
VBSでテキストファイルの2行目...
-
40代後半でゼロからのプログラ...
-
{ CONTROL Forms.Label.1}が...
-
Version Control on Unity
-
過剰なオブジェクト指向脳から...
-
VBAでパワーシェルを実行したい...
-
ImageMagickでgif画像の一部が...
-
正規表現 URL抽出「 [\\/\\b]{0...
-
VBA 電話番号の正規表現について
-
そのまま使っただけなのに・・...
-
プログラム言語について。
おすすめ情報