学校行事やアルバイトなどのシフト管理で時間帯ごとのシフト表を作る機会は多いかと思いますが、
忙しい中で用意しなければならないことが多く、なるべく手間をかけたくないところですよね。
けど、そんな中でやっぱり面倒だなと思うことは、
・毎回時間帯のスケジュール表をつくることは面倒
・参加する時間帯に色をつけたいがやり方がわからない
・ガントチャート形式のシフト表がほしいけどよいテンプレートがない
・30分や15分単位で表示できるガントチャート形式のシフト表がほしいけどやり方がわからない
ということはありますよね。
今回は、そんな面倒なことを解消する、
・ガントチャート付きシフト表へ休憩時間を追加する方法
・ガントチャート付きシフト表の表示単位を変更する方法
についてまとめます!
もくじ
ガントチャート付きシフト表の完成イメージ
ガントチャート付きシフト表の完成イメージは以下の通り、出勤時間帯に色が入り、さらに遅番早番などの勤務種別の文字が自動的に入るようになっています。
さらに時間帯列の初めのセルの時間を変えると、自動的に時間帯は変更され、色、勤務種別も再計算されます。
▼
別のシフト表をつくる場合、タイトルや時間帯の変更だけで済むという訳で、
シフト表作成の手間がずいぶん省けますね!
では、作り方について説明をします。
ガントチャート付きシフト表の作成手順
まずは、以下のようにメンバーと出勤・退勤時間、勤務種の表を用意します。
①時間帯列を作成する
まずは時間帯列を作成しましょう。
今回は、時間帯列のはじめのセルだけを変えたら他のセルも自動的に時間帯が入力されるようにします。
時間帯は1日ですので、最大0:00~23:00となりますが、
利用状況に応じてアレンジしていただければと思います。
今回のサンプルは午前6:00を指定しますので、F2セルに6:00を入力します。
セルの書式設定は、「時刻」>「13:30」を指定します。
続いて隣のセルの値ですが、自動掲載をさせたいので、
=F2+TIME(1,0,0)
を入力します。
これはF2セルの値に1時間を加算するという意味となります。
次に「7:00」が入力されたセルを時間帯終了列の位置までドラッグします。
はい、これで時間帯列の作成は完了です。
②ガントチャートを作成する
続いて、今回のメインとなるガントチャートが表示されるよう作り込んでいきましょう。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、以下を入力します。
=IF(AND(F$2>=$B3,G$2<=$C3),$E3,"")
入力が完了すると、以下のようになります。
変わらない方は出勤時間、退勤時間が正確に入力されているか、セルの指定が間違っていないか確認してください。
次に関数を入力したセルを時間帯最後尾列までドラッグします。
続いて、最後のメンバの行までドラックします。
はい、勤務種の文字だけですが、ガントチャートっぽくなりましたね。
③ガントチャートに色を入れる
続いてガントチャートをより見やすくするためにセルや文字に色を付けていきましょう。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ウインドウが表示されたら、「指定の値を含むセルだけを書式設定」を選択し、
ルールの内容のところに「セルの値」、「次の値に等しい」を選択、「早番」と入力します。
次に、セルの色、文字の色を「書式」から指定し、「OK」をクリックします。
「適用先」の範囲を拡張し、時間帯の最後尾列、メンバの最終行の範囲を指定します。
=$F$3:$X$7
入力が終わったら、「OK」をクリックします。
はい、早番のセルの色が変わりましたね。
次に同じ要領で遅番のセルも色を付けていきます。
1番目のメンバで、時間帯のはじめとなるF3のセルを選択し、
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ルールの内容のところに「セルの値」、「次の値に等しい」を選択、「遅番」と入力します。
次に、セルの色、文字の色を「書式」から指定し、「OK」をクリックします。
以下を「適用先」へ入力し、ルールの範囲を拡張します。
=$F$3:$X$7
終わったら「OK」をクリックします。
はい!ガントチャートができ上りましたね!
③時間帯別の必要人数を計算する
続いて、時間帯別に必要な人数と出勤人数、過不足人数を算出するように計算式を追加します。
時間帯別の必要人数の行を追加し、任意の人数を入れていきます。
続いて、出勤人数を自動算出するようにします。
勤務種の早番、遅番となっていれば数字をカウントしたいので、
F9のセルに以下を入力し、
=COUNTIF(F3:F7,"早番") + COUNTIF(F3:F7,"遅番")
時間帯の最後尾列までドラッグしていきます。
続いて、過不足人数を自動計算させます。
F10セルに以下を入力し、
=F9-F8
時間帯の最後尾列までドラッグしていきます。
この時点で、過不足人数が自動計算されていることがわかるかと思います。
次に、「-1」以下となっている不足しているセルをもっと目立たせるように赤く塗りつぶしていきます。
リボンメニューの「条件付き書式」をクリックし、「新しいルール」をクリックします。
ルールの内容のところに「セルの値」、「次の値より小さい」を選択、「0」と入力します。
次に、赤っぽいセルの色、文字の色を「書式」から指定し、「OK」をクリックします。
以下を「適用先」へ入力しルールの範囲を拡張します。
=$F$10:$K$10
完了したら「OK」をクリックします。
はい!「-1」となっているセルが赤色に変更されましたね!
ガントチャート付きシフト表へ休憩時間を追加する
シフト表へ出退勤の時間のほかに休憩時間を追加します。
こちらが完成イメージです。
①休憩時間を入力する列を作成する
休憩時間の「開始時間」と「終了時間」、そして「休憩時間」とタグの「Pos」の列を作成します。
②休憩時間の計算式を挿入する
休憩時間の計算式を挿入します。
H3セルの場合は以下の計算式となります。
=G3-F3
最下部までドラッグします。
③タグを挿入する
休憩であるとわかるようにタグを挿入します。
サンプルでは「休憩」とし、最下部まで入力します。
④ガントチャート部の計算式を変更する
ガントチャート部へ挿入されている既存の計算式を変更します。
J3列を選択し以下の計算式を入力します。
=IF(AND(J$2>=$F3,K$2<=$G3,$I3="休憩"),IF(AND(J$2>=$F3,K$2<=$G3),$I3,""),IF(AND(J$2>=$B3,K$2<=$C3),$E3,""))
次に最下位の行までドラッグし、最終列までドラッグします。
④「休憩」がガントチャートへ表示されるか確認する
「休憩」がガントチャートへ表示されるか確認しましょう。
はい、表示されますね。
ガントチャート付きシフト表の表示単位を変更する
ガントチャート付きシフト表の表示単位はこれまで1時間単位で設定してきましたが、
30分単位や15分分単位で設定したい場合がありますよね。
現在の仕様ですと、時間の間隔が1時間未満の場合、ガンチャートへ表示されませんので、
こちらを30分や15分間隔でも表示できるように設定を変更していきたいと思います。
こちらが完成イメージです。
■30分単位
■15分単位
ガントチャート付きシフト表の表示単位を30分単位に設定する
ガントチャート付きシフト表の表示単位を30分単位に変更してみましょう。
まずは、時間列を修正します。
開始時間の次のセルに30分追加した時間を入力します。
終了時間のセルまでドラッグしコピーします。
続いて、数式を終了時間の列までドラッグしてコピーします。
数式は1時間間隔版と同じです。
J3列を選択し以下の計算式を入力します。
=IF(AND(J$2>=$F3,K$2<=$G3,$I3="休憩"),IF(AND(J$2>=$F3,K$2<=$G3),$I3,""),IF(AND(J$2>=$B3,K$2<=$C3),$E3,""))
30分間隔のガントチャート付きシフト表の完成です。
ガントチャート付きシフト表の表示単位を15分単位に設定する
次はガントチャート付きシフト表の表示単位を15分単位に変更してみましょう。
時間列を修正します。
開始時間の次のセルに15分追加した時間を入力します。
終了時間のセルまでドラッグしコピーします。
続いて、数式を終了時間の列までドラッグしてコピーします。
こちらの数式は1時間間隔版と若干異なり、元のシリアル値に0.0001を加減しています。
15分単位の場合、シリアル値に変換すると割り切れないケースがあり、誤差が生じるためです。
けれど書式が異なるセルに13:15と入力すると、シリアル値は「0.552083333333334」になったりします。
おそらくExcelの仕様によるものと思いますが、イコールの条件にならない場合があり注意したいところですね。
J3列を選択し以下の計算式を入力します。
=IF(AND(J$2>=$F3-0.0001,K$2<=$G3+0.0001,$I3="休憩"),IF(AND(J$2>=$F3-0.0001,K$2<=$G3+0.0001),$I3,""),IF(AND(J$2>=$B3-0.0001,K$2<=$C3+0.0001),$E3,""))
15分間隔のガントチャート付きシフト表の完成です。
以下のように書式とレイアウトを変えてみるとよいですね。
ガントチャート付きシフト表へ2つ目の休憩時間を追加する
読者様のご要望がありましたので、ガントチャート付きシフト表へ2つ目の休憩時間を追加する方法について説明をします。
こちらが完成イメージです。
一つ目の休憩欄の右横に2つ目の休憩欄を設け、シフト表へ反映させていきます。
30分、15分単位に設定したい場合は一つ目の休憩設定の項目を参考に設定をしてください。
①二つ目の休憩時間を入力する列を作成し、計算式と値を設定する
一つ目の休憩欄の右横に2つ目の休憩欄を追加しましょう。
サンプルではJ~M列に追加をしています。
休憩時間の計算式は3行目L列に
=K3-J3
を入力し、下位行までドラッグしていきます。
タグであるM列のPos項目へ
「休憩2nd」
と入力します。
仕上げに、休憩時間を一つ目の休憩時間と重ならない時間帯で入力していきましょう。
②ガントチャート部の計算式を変更する
ガントチャート部へ挿入されている既存の計算式を変更します。
N3列を選択し以下の計算式を入力します。
=IF(AND(N$2>=$F3,O$2<=$G3,$I3="休憩"),IF(AND(N$2>=$F3,O$2<=$G3),$I3,""),IF(AND(N$2>=$J3,O$2<=$K3,$M3="休憩2nd"),$M3,IF(AND(N$2>=$B3,O$2<=$C3),$E3,"")))
次に最下位の行までドラッグし、最終列までドラッグします。
③「休憩2nd」がガントチャートへ表示されるか確認する
「休憩2nd」がガントチャートへ表示されるか確認しましょう。
はい、表示されますね。
3つ目、4つ目の休憩をガントチャートへ追加する
3つ目、4つ目の休憩をガントチャートへ追加する方法について説明をします。
追加する要領は2つ目と同様、表へ3つ目以降の休憩欄を追加し、関数を変更していきます。
2つ目休憩欄以降に3つ目と4つ目の休憩欄を追加します。
休憩開始 | 休憩終了 | 休憩時間 | Pos | 休憩開始 | 休憩終了 | 休憩時間 | Pos | 休憩開始 | 休憩終了 | 休憩時間 | Pos |
15:00 | 16:00 | 1:00 | 休憩2nd | 18:00 | 19:00 | 1:00 | 休憩3rd | 20:00 | 21:00 | 1:00 | 休憩4th |
V3列を選択し以下の計算式を入力します。
=IF(AND(V$2>=$F3,W$2<=$G3,$I3="休憩"),IF(AND(V$2>=$F3,W$2<=$G3),$I3,""),IF(AND(V$2>=$J3,W$2<=$K3,$M3="休憩2nd"),$M3,IF(AND(V$2>=$N3,W$2<=$O3,$Q3="休憩3rd"),$Q3,IF(AND(V$2>=$R3,W$2<=$S3,$U3="休憩4th"),$U3,IF(AND(V$2>=$B3,W$2<=$C3),$E3,"")))))
仕上げに最下位の行までドラッグし、続いて最終列までドラッグしていきます。
さいごに
いかがでしょうか?
今回は、
・ガントチャート付きシフト表へ休憩時間を追加する方法
・ガントチャート付きシフト表の表示単位を変更する方法
についてまとめました!
よく利用するExcelのシフト表。
ガントチャートもマスターしてより使い分けしたいですね!
早速 相談完成かと思われましたが 、少し不便が出ました
ユーザーフォームを表示しリストボックスクリック時値ははいります
問題なし
この後の動作で マウスでセルを移動するのですが 矢印での移動も可能にしたいのですが 入力後フォーカスをセルに持っていき自由に移動したいのですが
ユーザーフォーム表示
Sub 入力()
On Error Resume Next
UserForm1.Show vbModeless
With UserForm1
.StartUpPosition = 0
.Top = 20
.Left = 30
End With
On Error GoTo 0
End Sub
リストぼっくクリック
Private Sub ListBox1_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim i As Integer
With ListBox1
For i = 0 To 5
ActiveCell.Offset(i, 0).Value = .List(.ListIndex, i)
Next i
End With
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
UserForm1.Show vbModeless このモードでセルは移動できるのですが
フォーカスがリストボックスに残ったままで マウス操作になります
ユーザーフォームは開いたまま 入力後は ENTER 矢印などでもセルを
移動したいのですが
ユーザーフォームを表示させた後、セルへフォーカスしキーボードの操作を行う方法につきまして、
いくつかの方法(セルセレクト、ブックアクティブ化など)を検証してみましたが、実現は難しい状況でした。
モードレス表示となっていますので、一度セルやシートをクリックした上キーボードの操作を行っていただければと存じます。
ありがとうございます 私なりにいろいろ試しましたがむつかしいのですね
取り合えづ完成いたしましたありがとうござます
最高です
完成いたしました あとは 各反応を見ながら 適時修正して
完璧なものに近づけていきたいとおもいます
また困りごとがありましたら 相談させてください
少し形式を変えました 行の検索で バラバラの行を抽出するようにいたしました
精査お願いいたします 他のサイトのものを検証可変したものです
Dim i As Long
Dim mySh As Worksheet
Dim myFlg As Boolean
Dim lastRow As Long, myRow As Long
Dim myK As String
Set myDic = CreateObject(“Scripting.Dictionary”)
‘ —(1)元データの項目を配列に格納
lastRow = Worksheets(“Sheet1”).Range(“E” & Rows.Count).End(xlUp).Row ‘種類列
myVal = Worksheets(“Sheet1”).Range(“E2”, “E” & lastRow).Value ‘種類列
‘ —(2)myDicへデータを格納
For Each c In myVal
If Not c = Empty Then
If Not myDic.Exists(c) Then
myDic.Add c, “”
End If
End If
Next
‘—-振り分け先のシートが存在するか否かをチェック
myKey = myDic.Keys
For i = 0 To myDic.Count – 1
For Each mySh In Worksheets
myFlg = False
If mySh.Name = myKey(i) Then
myFlg = True
mySh.Cells.Delete
Exit For
End If
Next mySh
‘—-振り分け先のシートがなかったらシートを追加する
If myFlg = False Then
ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = myKey(i)
End If
‘—-列見出しをコピー&貼り付け
Worksheets(“Sheet1”).Range(“A1:E1”).Copy Worksheets(myKey(i)).Range(“A1”)
Next i
‘—-データを転記する
For i = 2 To lastRow
myK = Worksheets(“Sheet1”).Range(“E” & i).Value
If myK “” Then
myRow = Worksheets(myK).Range(“E” & Rows.Count).End(xlUp).Row + 1
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy _
Worksheets(myK).Range(“A” & myRow & “:E” & myRow)
End If
Next i
Set myDic = Nothing
End Sub
うまくいっているようなんですが 式も同時に入るので困っています
書式と値のみにするにはどのようにしたらよいでしょう?
書式と値のみという条件でペーストするには二段階で行う必要があります。
1回目で書式のみコピーして次に値のコピーを行ってます。
以下ご参考ください。
変更前
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy _
Worksheets(myK).Range(“A” & myRow & “:E” & myRow)
変更後
Worksheets(“Sheet1”).Range(“A” & i & “:E” & i).Copy
Worksheets(myK).Range(“A” & myRow & “:E” & myRow).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Worksheets(myK).Range(“A” & myRow & “:E” & myRow).PasteSpecial Paste:=xlPasteValues
みません 私勘違いをしておりまして 行の抽出でした そこで下記のように書き直してみました
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出行 As Variant
Dim i As Long
Set データ範囲 = Sheets(“シフト”).Range(“A8:AG130”).CurrentRegion
抽出行 = Array(16, 16)
Dim objWs As Worksheet
Set objWs = Sheets.Add(after:=Worksheets(Worksheets.Count))
objWs.Name = Sheets(“シフト”).Range(“AG1”)
For i = 0 To UBound(抽出行)
データ範囲.Rows(抽出行(i)).Copy objWs.Range(“A1”).Offset(0, i)
Next i
End Sub
シート名の値を シフトシートのAG1に変更いたしました
16行目を取得してます なぜかAの列の値が2つ入ります
別シートに A16 A16 B16 C16~ となぜかA16の値が2個
またA16には関数が入れてあるので +#REF! です これは値と書式のみの取得にすれば 良いのでしょうか?
同時に 複数行も取得したいのですが
A16 A18 A20とか 行は飛び飛びです
また、シフトの値を変えた場合再度同じシートを書き換えたいのですが
どうしてもAG1の値で一度新規シートができているので現状エラーが出ます
Dim Key As String ’ キー
Dim Flg As Boolean ’フラグ
Dim She As Worksheet ‘キーに対するシート名
を追加して
For Each She In Worksheets
Flg = False
Key = Worksheets(“シフト”).Range(“AG7”).Value
If She.Name = Key Then
Flg = True
She.Range(“A1:AG130”).ClearContents ‘シートの上書きのため 範囲をクリア
Exit For
End If
Next She
シートがなかったらシートを追加する
If Flg = False Then ActiveWorkbook.Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Key
End If
そしてぐちゃぐちゃになりわけがわからなくなってます
ご指導のおかげで 何とか完成まで近づきました ありがとうございます
あと一つ、こんな風にできたらよいなと思うのですが 少しググっていたら見かけたのですが
「ひと月単位で作成して 作成したものを 同じブックの別シートに必要な行だけ取り出し シート名を 特定のセルの値に対して追加する」
作成中のものは ひと月20人分 一人分が6行です ひと月分で120行使います
12か月分作ると1500行ぐらい使います ですので ひと月分を
月を変えると日付、曜日が連動するように作っています
一人分が6行のため 丸ごとシートコピーするのではなく必要な行だけ
取り出したいのです
A7に 2021年7月 とあります 追加のシートの名前は A7の値
取り出したい行は A8行目の日付 A9行目の曜日
A10行目の名前とシフトの場所 あと各STAFFの同じ行です
次のスタッフは A16行目 と飛び飛びです
月途中でも 保存でき、同じシート名の場合上書きする
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出列 As Variant
Dim i As Long
Set データ範囲 = ActiveSheet.Range(“A8:AG130”).CurrentRegion
抽出列 = Array(1, 3)
Sheets.Add.Name = “Range(A1)”
For i = 0 To UBound(抽出列)
データ範囲.Columns(抽出列(i)).Copy Sheets(“抽出”).Range(“A1”).Offset(0, i)
Next i
End Sub
何かわけのわからないこと書いてます すみません
形になってきたようでよかったです。
追加のご質問
「ひと月単位で作成して 作成したものを 同じブックの別シートに必要な行だけ取り出し シート名を 特定のセルの値に対して追加する」
ですが、いただいたVBAに少し追加、変更をいたしましたのでご確認の程お願いいたします。
Sheets.Add.Name = “Range(A1)”
→objWs.Name = Sheets(“<シート名を記載>”).Range(“A7”)
“A7″へ変更しました。
データ範囲.Columns(抽出列(i)).Copy Sheets(“抽出”).Range(“A1”).Offset(0, i)
→データ範囲.Columns(抽出列(i)).Copy objWs.Range(“A1”).Offset(0, i)
追加したシートへ追記するようにしました。
抽出列や範囲は適宜調整頂ければと存じます。
Sub 新規シート保存()
Dim データ範囲 As Range
Dim 抽出列 As Variant
Dim i As Long
Set データ範囲 = Sheets(“<シート名を記載>”).Range(“A8:AG130”).CurrentRegion
抽出列 = Array(1, 3)
Dim objWs As Worksheet
Set objWs = Sheets.Add
objWs.Name = Sheets(“<シート名を記載>”).Range(“A7”)
For i = 0 To UBound(抽出列)
データ範囲.Columns(抽出列(i)).Copy objWs.Range(“A1”).Offset(0, i)
Next i
End Sub
=IF(RIGHT(B15,1)=”,”,REPLACE(B15,LEN(B15),1,””),B15)
SUBSTITUTE関数結果を“B15”
この方法がべすとのような気がいたします シートを二枚使用すればCSVに
無事に吐き出せそうですね 一行で書くのは難ありですね
根気よくやりたいと思います
早速ありがとうございます
=SUBSTITUTE(SUBSTITUTE(シフト!C11&”,”&シフト!C12&”,”&シフト!C13&”,”&シフト!C14&”,”&シフト!C15,”,,,”,””),”,,”,””)
で記入してみました
結果
C10 に値があり他空白の場合
9:30,17:00, 最後に コンマが残り csv NGでした
2個の場合OK
3個の場合OK
4個の場合NG
5個の場合OK という結果でした どうしても最後にコンマが残るパターンが
出現します 「 , ] コンマ一つを置換対象に入れてしまうと
今度はつながりがおかしくなります
どうしたらよいのか
このような考えはいかがでしょう
&”,”&の部分をそれぞれ違うパターンでつないでおいて出てきたパターンを置換していく 何やら混乱してきました
最後にコンマが残るパターンの対応ですが、
最終文字列が「,」である場合に削除する処理を加えるやり方でいかがでしょうか。
=IF(RIGHT(B15,1)=”,”,REPLACE(B15,LEN(B15),1,””),B15)
SUBSTITUTE関数結果を“B15”に表示させ、別のセルに上記計算式を入れてください。
>&”,”&の部分をそれぞれ違うパターンでつないでおいて出てきたパターンを置換
こちらのやり方も有効かと思われます。
たとえば、C列のセルが空欄である場合に明示的に判断できる記号を表示させ、それを除外するというやり方です。
以下サンプルです。
D列に ※D10入力前提です。D14までドラッグしてコピーしてください。
= IF(C10 = “”, “値なし”,C10) ※空欄の場合”値なし”と表示されます。
計算列に
=SUBSTITUTE(D10&”,”&D11&”,”&D12&”,”&D13&”,”&D14,”,値なし”,””) ※”,値なし”を除外します。
を入れます。
ご検討の程お願いいたします。
ありがとうございます そうですね 体感的にはあまり変わらないような気がします
お手数かけました
毎日あちこちの文献をあさりながら 勉強をしているのですが、それぞれ同じ動作をするのに表現方法が違うのでどれが正解なのかさっぱりわかりません
基礎がないとだめなのですかね
さて 私のシフト管理も 最終CSVまで吐き出せるようになりました
勤務体系が 非常に複雑なので大変な作業です
また、それぞれ使う環境で動いたり動かなかったりで 時間の浪費が激しいです
シフトにしても50形態ぐらいあるので、あたま痛いです
これから、WEBのシステムにUPすることを考えてますが 少し断念
頭が回りませんここで少し
質問させてください
=TEXTJOIN(“,”,,TEXT(L12:S12,”h:mm;;”))の関数が新しく旧バージョンであまりよろしくないので以下のようにしましたご確認お願いいたします
内容は 5つのセルの内容を コンマでつないで一つのセルに入れているのですが
通常でつなぐと 空白のせるがどうしても コンマ が残ってしまい
UP
UPしたときに認識できないので コンマを消す作業です 長いです
+IF(シフト!C11=””,””,シフト!C11)&IF(AND(シフト!C11″”,シフト!C12″”),”,”,””)&IF(シフト!C12=””,””,シフト!C12)&IF(AND(シフト!C11&シフト!C12″”,シフト!C13″”),”,”,””)&IF(シフト!C13=””,””,シフト!C13)&IF(AND(シフト!C11&シフト!C12&L3″”,シフト!C14″”),”,”,””)&IF(シフト!C14=””,””,シフト!C14)&IF(AND(シフト!C11&シフト!C12&シフト!C13&シフト!C14″”,シフト!C15″”),”,”,””)&IF(シフト!C15=””,””,シフト!C15)
ご質問の内容を確認させて頂きたく、
空白のセルにコンマ「,」が残るので削除する
という部分ですが、以下の認識でよろしいでしょうか。
値A+空白+値B+値C+値D
↓ コンマ「,」で結合
値A,,値B,値C,値D
となり、その中の
「,,」を「,」
に変更する。
サンプルデータがあればありがたいです。
よろしくお願いいたします。
説明不足ですみません
まず、画面が挿入できれば良いのですが 文章で説明いたします
例
今作りこみ中の分で説明いたします
シートは今のところ4シートです
1,シフト(月) 2,時間帯(ガンチャート、日) 3,設定 4,csv
この中の時間帯を CSVにすというところです
設定で
J3~S3 まで
始業、終業、休1,復1、休2、復2、休3、復3、休4、復4
とあります
ガンチャート作成のためそれぞれの値を入れるようにしてます これが基本設定です
シフト画面に入れるため それぞれSETで
U3~Y3まで それぞれ
=IF(J3=””, “”, TEXT(J3,”[h]:mm”) &”,”&TEXT(K3,”[h]:mm”))
でつないで 9:00,16,00 始業と終業を U3に入れるようにしてます
順に 始業終業、休復1、休復2,休復3,休復4 となってます
上記関数の場合 &”,”& でコンマでつないでます J3が空白なら計算しない
これは、自分的には 正解かと思います
次にこのつないだ時間帯を シフト表に入れるのですが
ユーザーフォームでこの値を取り 入れていきます
社員一名の シフト 6行です
C10から下へ
シフト名
勤務 C10 9:00.16:00 ここが休日、有給などの時もある
休1 C11 11:00,12:00
休2 C12 空白
休3 C13 空白
休4 C14 空白
あとはこの五つのセルの値を 結合して CSV シートの 一つのセルに入れる
ここから 問題部分です
すでにテキスト変換されているので ”[h]:mm” の部分は 必要ない?
=IF(J10=””, “”, TEXTJOIN(“,”,,TEXT(C10:C14,”h:mm;;”)))
問題なし
9:00,16:00,11:00,12:00
しかしバージョン古いと使えない
最初の関数で
=+IF(C10=””, “”, C10&”,”&C14) でつなぐ
9:00,16:00,11:00,12:00,,,
空白があるために 最後に「 ,,, 」 コンマがの残ってしまう
この最後のコンマの処理です
C10~C14のいづれか一つでも空白があれば その空白を飛ばし
次のセルの値をつなぐ この辺りは CSV で出力する際にBVAでもよかなと思うのですが 処理がわかりません
試しに
Sub 文字結合2()
Dim 結合文字 As String
Dim 範囲 As Range
結合文字 = “”
For Each 範囲 In Range(“C10:C14”)
結合文字 = 結合文字 & 範囲.Text & “,”
Next 範囲
Range(“B15”).Value = 結合文字
End Sub
としてみましたが 空白で「,,, 」 が残りました
ご連絡ありがとうございます。
「,,, 」の処理ですが、SUBSTITUTE関数で置換する方法でいかがでしょうか。
=SUBSTITUTE(C10&”,”&C11&”,”&C12&”,”&C13&”,”&C14,”,,,”,”,”)
「,,, 」のほかに「,, 」も置換対象とする場合は以下のように入れ子にします。
=SUBSTITUTE(SUBSTITUTE(C10&”,”&C11&”,”&C12&”,”&C13&”,”&C14,”,,,”,”,”),”,,”,”,”)
ただし、以下のパターンの場合はCSVの構成が変わってしまいますのでご注意ください。
休1 C11 空白
休2 C12 空白
休3 C13 空白
休4 C14 値あり
休1 C11 値あり
休2 C12 空白
休3 C13 空白
休4 C14 値あり
よろしくお願いいたします。
ありがとうございます ばっちりです
少しパフォーマンスもあがったような気がします
パフォーマンスで気になるところがあるのですが
A列に ★★★★のマークがある場合 その行を非表示にする
Sub 休4()
Application.ScreenUpdating = False
Static ChkNext As Boolean
If ChkNext = False Then
ChkNext = True
‘MsgBox “1回目の押下です。”
‘ここに1回目の実行コードを記述
Dim rw As Long ‘// 行カウンタ
For rw = 10 To Range(“A200”).End(xlUp).Row
If Range(“A” & rw).Value = “★★★★” Then
Rows(rw).Hidden = True
End If
Next
Else
ChkNext = False
Call 復4
End If
Application.ScreenUpdating = True
End Sub
と書いています 少しもっさりするのですが 改善方法はありますか?
しかしいつもながら 勉強させていただいて感謝しております
どのような文献を読んで勉強されているのか 差し支えなければご教授ください
私も、もうすぐ定年なので ボケ防止でさらに勉強したいです
動作改善の件ですが、
For rw = 10 To Range(“A200”).End(xlUp).Row
If Range(“A” & rw).Value = “★★★★” Then
Rows(rw).Hidden = True
End If
Next
を
temp = Range(“A10:A200”)
For rw = 1 To UBound(temp)
If StrComp(temp(rw, 1), “★★★★”) = 0 Then
Rows(rw + 9).Hidden = True
End If
Next
に変えていかがでしょうか。
※こちらの環境ですともっさりしなかったのであまり差は感じませんでした…
また、VBAの勉強法ですが、体系的に学んだというわけではなく、
業務上必要になったので調べ、作り、覚えてきたという感じです。
ただ、その中でよかった学習法は動画教材で、よく通勤中に視たり、聴いたりしていました。
すこしお金がかかってしまいますが、Udemyの研修は何回も受講できるのでよかったです。(企業向けもあるようです)
Excel VBAに関する良書はたくさんありますので、別の記事にでもまとめたいとおもいます。
よろしくお願いいたします。
コンパイルエラー ステートメントの最後 arr が候補になってます
無効かして End With より上です
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim lastRow As Long
‘ListBox1.Clear
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
‘.RowSource = “設定!” & Range(“T3:Z30”).Address コメントアウト
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e)
Next d = d + 1 End If c = 0 Next .List = arr
End With
Application.ScreenUpdating = True
End Sub
承知いたしました。
以下に差し替えご確認頂けますでしょうか。
Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim lastRow As Long
‘ListBox1.Clear
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
‘.RowSource = “設定!” & Range(“T3:Z30”).Address コメントアウト
‘空白行削除処理
temp = Sheets(“設定”).Range(“T3:Z30”)
Dim arr() As Variant
ReDim arr(1 To UBound(temp, 1), 1 To UBound(temp, 2))
c = 0
d = 1
For a = LBound(temp, 1) To UBound(temp, 1)
For b = LBound(temp, 2) To UBound(temp, 2)
If temp(a, b) = “” Then
c = c + 1
End If
Next
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = Format(temp(a, e), "hh:nn") Next d = d + 1 End If c = 0 Next .List = arr End With Application.ScreenUpdating = True End Sub
ほぼ完成と思いきや 致命的なことがありました
シフト複数あり それぞれに 始業 終業 休憩1 復帰1 休憩2 復帰3
シフトA 9:00 18:00 12:00 13:00 15:00 15:15
このようなパターンを基本としマスターとして 別シートの時間範囲に入れてあります10パターン程
セルA1に入力規則で リストを表示しそこに シフトAと入るようにして
A2 A3 A4にVlookup関数を使いそれぞれの時間が入るようにしております
=IFERROR(VLOOKUP(A1,時間,13,0),””)
うまく取得してくれて それぞれの値が 各セルに代入されました
が 問題ありました マスターの数字を触ると すべての数字が変わりました
あらー A2が 9:00 したら マスターを10:00にするとすべて変わる
考えてみれば当然ですね かといって パターンを増やすのも選択が大変
入力された値を 手動入力すると 式が消える
で考え付いたのが VBAでフォームを作り リストを表示 その値をセルに代入
編集可能にしました
該当セルのクリックでフォームを表示 フォームのコード
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
‘ダブルでマクロ
If Not Application.Intersect(Target, Range(“A1:A21”)) Is Nothing Then
Cancel = True
UserForm1.Show
End If
End Sub
フォームのコード
Private Sub UserForm_Initialize()
Dim lastRow As Long
lastRow = Sheets(“設定”).Cells(Rows.Count, 1).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 10
.ColumnWidths = “40;50;50;50;50;50;50;50”
.RowSource = “設定!” & Range(“I2”, “S50” & lastRow).Address
End With
リストが表示されました 問題はここから それぞれの値をセルに代入するため
フォームコードに
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveCell = ListBox1.List(ListBox1.ListIndex, 0)
End Sub
を記入 A1に 選択の値が入ります OK
A2からは何も入らないこの場合
A1に シフトA
A2に 9:00
A3に 18:00
A4に 12:00 と以下順番にリストの値を入れたいのですが
ActiveCell.Offset(1).Select を書いてみたのですが ずれるだけ
代入が完了したら フォームを自動で閉じたいのですが
どうもこの辺が 苦手です よろしくお願いいたします
リストボックスからActiveCellへの代入する件ですが、
ActiveCellとOffsetを使って選択セル以下へ代入するということでしたら
ActiveCell = ListBox1.List(ListBox1.ListIndex, 0)
ActiveCell.Offset(1).Activate
ActiveCell = ListBox1.List(ListBox1.ListIndex, 1)
ActiveCell.Offset(1).Activate
ActiveCell = ListBox1.List(ListBox1.ListIndex, 2)
・・・
という形となります。
代入完了後ユーザフォームを閉じる方法は
Unload UserForm1
を代入処理の最後に入れてください。
よろしくお願いいたします。
ありがとうございます 完璧です
色々調べているのですが リストボックスを表示したときに空白行の処理をしたいのですが よくわかりません
Private Sub UserForm_Initialize()
Dim lastRow As Long
lastRow = Sheets(“設定”).Cells(Rows.Count, 3).End(xlUp).Row
With ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = “80;60;60;60;60;60;10;10”
.RowSource = “設定!” & Range(“T3:Z30”).Address
End With
End Sub
のように書きましたが 設定の範囲のところに 式はありますが
空白になる行があり
そのあとにまた 値があります ユーザーフォームを開いたときに空白行になります いかに処理したらよろしいでしょうか
T3の行は 値あり
T5~T10まで 空白
T10~また 値あり です
またユーザーフォームを
UserForm1.Show vbModeless
モードで開いた時の セルの入力範囲の規制をしたいのですが
例えば A1~A20,C1~C30 の範囲は入力できるが ほかのセルには入力できないとか よろしければ ご教授ください
いつもすみません
リストボックスの空白行非表示の件ですが、
Range(“T3:Z30”)を配列に格納して、すべての列が空白である行を除外する処理をすればよいかと思われます。
.RowSource = “設定!” & Range(“T3:Z30”).Address
をコメントアウトし以下へ変更します。
‘空白行削除処理
temp = Sheets(“設定”).Range(“T3:Z30”)
Dim arr() As Variant
ReDim arr(1 To UBound(temp, 1), 1 To UBound(temp, 2))
c = 0
d = 1
For a = LBound(temp, 1) To UBound(temp, 1)
For b = LBound(temp, 2) To UBound(temp, 2)
If temp(a, b) = “” Then
c = c + 1
End If
Next
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e) Next d = d + 1 End If c = 0 Next .List = arr VBAだと少々複雑になるので、Excelシート側で空欄を除くフィルターなどかけるとよいかもしれません。 セルへの入力制限についてはExcelの標準機能の「シートの保護」で実現できるかと存じます。 よろしくお願いいたします。
If c < UBound(temp, 2) Then For e = LBound(temp, 2) To UBound(temp, 2) arr(d, e) = temp(a, e) Next d = d + 1 End If c = 0 Next .List = arr
の行でしょうか? エラーが出ます
すみません
エラーについてですが、どのような内容(エラーコード、メッセージ等)であるか教えて頂けますでしょうか。
また、
’.RowSource = “設定!” & Range(“T3:Z30”).Address
は無効化しているか、
End With
より上部に記載されているかもご確認頂けますでしょうか。
休憩時間を入れる場合どうすればいいのでしょうか、、、
いつもご利用ありがとうございます。
休憩時間については追加可能です。
ただし変更する箇所が多く、テキストのみですと説明が難しいので
本記事に画像付きで実装手順を追記させていただきました。
詳細については
本記事
https://extan.jp/?p=3011
の
「ガントチャート付きシフト表へ休憩時間を追加する」
をご参照頂きたくお願いいたします。
なるほどですね、やはり計算式ではかなり複雑で無理がありますね
検証いたします
いま取り組んでいるものが、ひと月の勤務表から 日毎に勤務時間を取り出し
日毎バーチャートを表示し その値をcsv化してウェブの勤務表にUP
UPロードするというのを作成中です
通常なら、そう難しいことではないのですが、
年中無休 勤務シフトバラバラ、休憩バラバラ 15分を4回であったり
30分を二回であったりと なので苦労しております
そこでこのようになっています
シート1 月30日分
一人の社員で7行使います
1行目 社員ID
2行目 各シフト 例えばシフトAとか
3行目 勤務総時間
4行目 休憩1
5行目 休憩2
6行目 休憩3
7行目 休憩4 としています
1日が C列としますと 2行目のシフトをプルダウンで 選び
3,4,5,6,7とIFERROR(VLOOKUP(C10,基本シフト,3,0),””)で取得しています
3,4,5,6,7はそれぞれ
IF(H3=0,””,TEXT(H3,”[h]:mm”) &”,”&TEXT(I3,”[h]:mm”))でつなぎ
9:00,18:00で表示させてます
時間帯だけ全部繋げて一つもセルに表示したいのですが 時間ごとに改行とかできれば 一つのセルに収まるのですが 良い方法はありませんか
また最初の総勤務時間だけフォントの大きさを違えるとか。。
先は長いですまた度々お世話になります
時間ごとに改行し、一つのセルに表示させる方法については
「9:00,18:00」を
「9:00
18:00」
にするということでしたら、
対象セルの書式を「折り返して全体を表示する」に設定した上、
TEXT(H3,”[h]:mm”) &”,”&TEXT(I3,”[h]:mm”)
を
TEXT(H3,”[h]:mm”) &CHAR(10)&TEXT(I3,”[h]:mm”)
に変更することでできます。
よろしくお願いいたします。
その方法しかないですかやはり ありがとうございます
また、問題が出てきました CSV出力時に 各時間を
9:00,17:00,11:30,12:00,15:00,15:30 のようにつなげて一つのセルに収めています
=TEXTJOIN(“,”,,TEXT(L12:S12,”h:mm;;”)) この関数を使いました
問題はないかと思うのですが これは新しい関数で バージョンが古いと
できないとか。。
ほかに方法はないかと探っています
=MID(J2:S2,1,999) なものでどうかと試しましたが うまくつながりません
時間が 0.75 とかになります セルの書式でもダメでした
また空白行もあるため うまくいかない
J3&”,”&B2&”,”&K3&”,”&L3&”,”&M3&”,”&N3&”,”&O3&”,”&P3&”,”&Q3&R3
な感じで試してみましたが 時間が 0.75とか0.15とかで
表示される 空白行が ,,,,,, で残る さてさていかがしたものですか
最悪 定義付けですかね
なるべくBVAは使いたくないのですが 重くなるので
Function TEXTJOIN(Delim, Ignore As Boolean, ParamArray par())
Dim i As Integer
Dim tR As Range
TEXTJOIN = “”
For i = LBound(par) To UBound(par)
If TypeName(par(i)) = “Range” Then
For Each tR In par(i)
If tR.Value “” Or Ignore = False Then
TEXTJOIN = TEXTJOIN & Delim & tR.Value2
End If
Next
Else
If par(i) “” Or Ignore = False Then
TEXTJOIN = TEXTJOIN & Delim & par(i)
End If
End If
Next
TEXTJOIN = Mid(TEXTJOIN, Len(Delim) + 1)
End Function
TEXTJOIN関数はExcel2016以降で追加された関数のようですね。
業務でご利用されるバージョンの確認と念のためユーザテストをしたほうがよいでしょう。
代案としては以下のような感じでしょうか。
=TEXT(L3,”h:mm;;”)&”,”&TEXT(M3,”h:mm;;”)&”,”&TEXT(N3,”h:mm;;”)
時間がシリアル値表示されているようですので、時間の表示形式に変換しています。
非常にややこしいので 仕様を変えました
セルA1から
始業 終業 休憩1 復帰1 休憩2 復帰2 休憩3 復帰3 休憩4 復帰4
9:00 18:00 10:00 10:15 11:00 11:15 12:00 12:15 14:00 14:15
と 4回の休憩を取ります 全体のチャートは表示できるのですが
休憩時間を空白で 表示したいのですがセルは15分間隔です
セルのE5から色付けしたいのですが 色または ■ ☆などのマークで入れたいのですが いつもむつかしいことを質問してすみません
休憩の時間を空白にしたいのですが
いつもご利用ありがとうございます。
ご質問の内容を整理致しますと、
①始業、終業、休憩時間(4つ)をガンチャートの情報から取得したい。
②現在関数で取得しているが動作が重たいので改善したい。
③ガンチャートは”■”や”☆”の記号で表現したい。
でしょうか。
①に関しては関数で対応できているようですので、問題なしとします。
②に関しては関数の条件式を減らすことをしない限り改善が難しいかと思われます。
③に関しては表記を加えるだけで良いかとおもいますが、条件式を加えるので②に影響することとなります。
そこでご提案ですが、VBAを利用して①を実現、②を解消する方法はいかがでしょうか。
随時実行させる手間はあるものの軽量化と動作の改善は可能かと思います。
以下VBAのサンプルとなります。
◇サンプルシート
セルA1から
名前 9:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 17:00 始業 終業 休憩1 復帰1 休憩2 復帰1 休憩3 復帰3 休憩4 復帰4
を入力。
A2からJ4セルへ以下を入力
Aさん ■ ■ □ ■ □ □ ■
Bさん ■ □ ■ □ ■ ■ □ □ ■
Cさん ■ □ ■ □ ■ □ ■ □ ■
※休憩は空欄だと始業取得に影響あり空欄ではなく□としています。
◇サンプルVBA
Sub シフト表から時間集計()
Dim tempHairetsu As Variant
Dim tempHairetsu1D As Variant
Dim dateStartTime As Date
‘基準時間指定
dateStartTime = Range(“B1”)
dateStartTime = DateAdd(“h”, -1, dateStartTime)
k = 0
‘ガントチャート情報を配列に格納
tempHairetsu = Range(“B2:J4”)
‘時間をクリア
Range(“L2:U4”).Clear
Debug.Print UBound(tempHairetsu)
‘人数分繰り返す
For i = 1 To UBound(tempHairetsu)
‘tempHairetsu = Range(“B” & i + 1 & “:J” & i + 1)
‘二次元配列を1次元に変換
tempHairetsu1D = WorksheetFunction.Index(tempHairetsu, i)
‘はじめの■の位置番号を取得
numKaishi = Application.Match(“■”, tempHairetsu1D, 0)
‘始業時間算出
Cells(i + 1, 12) = DateAdd(“h”, numKaishi, dateStartTime)
For j = 1 To UBound(tempHairetsu1D)
‘勤務”■”の位置取得
If tempHairetsu1D(j) = “■” Then
‘終業時間算出
Cells(i + 1, 13) = DateAdd(“h”, j + 1, dateStartTime)
End If
‘休憩”□”の位置取得
If tempHairetsu1D(j) = “□” Then
If Not tempHairetsu1D(j – 1) = “□” Then
‘休憩時間算出
Cells(i + 1, 14 + k) = DateAdd(“h”, j, dateStartTime)
End If
If Not tempHairetsu1D(j + 1) = “□” Then
‘復帰時間算出
Cells(i + 1, 14 + k + 1) = DateAdd(“h”, j + 1, dateStartTime)
k = k + 2
End If
End If
Next
k = 0
Next
End Sub
◇結果
始業 終業 休憩1 復帰1 休憩2 復帰1 休憩3 復帰3 休憩4 復帰4
10:00 18:00 12:00 13:00 14:00 16:00
9:00 18:00 10:00 11:00 12:00 13:00 15:00 17:00
9:00 18:00 10:00 11:00 12:00 13:00 14:00 15:00 16:00 17:00
※2行目からAさん、Bさん、Cさん分の結果となります。
ご検討宜しくお願い致します。
また、質問させていただきます ご迷惑ならごめんなさい
今度は、シフト表に取り掛かっています
ある程度の下地は あるのですが すごく重たくなりどうしたものかと思い
コメントさせていただきました
時間を入力して ガンチャートを作成するのではなく ガンチャートから時間を
吐き出すようにしております
エクセルの一つのマスを15分としております
朝9:00~17:00までを勤務とした場合 9時のセルから17:00のセルまで■を埋めていきます 最後のセルに 勤務時間が 8時間とカウントされます
そのあとに 休憩時間の取得です セルの■を消すとそこから休憩時間が始まり
空白の部分が休憩始まりと終わりです
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
となるようにしています
式は複雑で別シートに結果を吐き出し また戻すという方法です
F6から■を埋めるとして
別シートに15分単位で以下の式を入れてます
E7に
IF(AND(shift!$F$6=””,OR(COUNTIF(shift!$G$6,”■”),COUNTIF(shift!$G$6,”★”))),INDEX($D$1:$BP$1,0,(COLUMN(shift!$G$6)-5)),0)
E8に
IF(AND(OR(COUNTIF(shift!$G$6,”■”),COUNTIF(shift!$G$6,”★”)),shift!$H$6=””),INDEX($D$1:$BP$1,0,(COLUMN(shift!$G$6)-4)),0)
ざっとBQの列まで埋めていますそのあと
COUNTIF(BS7:CB7,”>0″)
LARGE($E7:$BQ8,9)
LARGE($E7:$BQ8,8)
と続けます
シフト表に戻り
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
時間を入れるため
IF(data!BR7=0,0,LARGE(data!$BS7:$CB7,data!BR7))
などと複雑になっています
一つのバーチャートの値をとるのに
2行と60列ぐらい使います 一人に対してですから もう途方もない作業となってます 簡素にできないかと思うのですが
始業 終業 休憩1 終了1 休憩2 終了2 休憩3 終了3 休憩4 終了4
9:00 18:00 10:00 11:00 15:00 15:30 0:00 0:00 0:00 0:00
の時間を取得できないかと 複雑すぎて説明ができなくなりました
すいません