Excelで時間帯ごとのガントチャート付きシフト表を瞬時に作成する方法!休憩時間つき!

学校行事やアルバイトなどのシフト管理で時間帯ごとのシフト表を作る機会は多いかと思いますが、

忙しい中で用意しなければならないことが多く、なるべく手間をかけたくないところですよね。

けど、そんな中でやっぱり面倒だなと思うことは、

・毎回時間帯のスケジュール表をつくることは面倒

・参加する時間帯に色をつけたいがやり方がわからない

・ガントチャート形式のシフト表がほしいけどよいテンプレートがない

・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分間隔のガントチャート付きシフト表の完成です。

タカヒロ
タカヒロ
出退勤、休憩時間を30分間隔にしてテストしてみてください。

ガントチャート付きシフト表の表示単位を15分単位に設定する

次はガントチャート付きシフト表の表示単位を15分単位に変更してみましょう。

時間列を修正します。

開始時間の次のセルに15分追加した時間を入力します。

終了時間のセルまでドラッグしコピーします。

続いて、数式を終了時間の列までドラッグしてコピーします。

こちらの数式は1時間間隔版と若干異なり、元のシリアル値に0.0001を加減しています。
15分単位の場合、シリアル値に変換すると割り切れないケースがあり、誤差が生じるためです。

タカヒロ
タカヒロ
例えば13:15の場合、シリアル値は「0.552083333333333」と循環小数になります。
けれど書式が異なるセルに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分間隔のガントチャート付きシフト表の完成です。

 

タカヒロ
タカヒロ
15分刻みですと時間列の数が多くなりますので、
以下のように書式とレイアウトを変えてみるとよいですね。




さいごに

いかがでしょうか?

今回は、
時間帯ごとのガントチャート付きシフト表を瞬時に作成する方法について
まとめました!

よく利用するエクセルのシフト表。

ガントチャートもマスターしてより使い分けしたいですね!

Excel関数でシフト表の曜日祝日つきカレンダーを瞬時に作成する

Excelで日別シフト表を自動作成する方法!土日祝日定休日カレンダー付き!


47 件のコメント

  • 15分単位のシフト表が欲しかったので、時間軸の数式を「+TIME(0,15,0)」に変えて作成しましたが、上手く表示される箇所もあれば、休憩時間が反映されなかったり退勤じかんが15分ズレてしまったりしますが原因が分からないので対処出来ません…
    分刻みだと難しいですか?

  • 先の質問で以下の内容でVBAに記述しました
    Sub test()
    Range(“A6”).Formula = “=+IFERROR(INDEX(シフト!$A$1:$AG$129,MATCH($A11,シフト!$A$1:$A$129,0)-1,MATCH($B$7,シフト!$A$8:$AG$8,0)),””)”
    Range(“A6”) = Range(“A6”).Value
    End Sub
    などでオートメーションエラーがでます 少し区別がわからづ温和くしております
    ほかの計算式だとうまくいくのですが
    例えば以下の計算式
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range(“F10:BR10”)) Is Nothing Then
    Range(“BY9”).Formula = “=IF($BY$253=0,0,LARGE($BZ$253:$CJ$253,$BY$253))”
    Range(“BZ9”).Formula = “=MAX($BZ$253:$CJ$253)”
    Range(“By9:Bz9”).Value = Range(“By9:BZ9”).Value
    End If
    End Sub

    最初の計算式ではオートメーションエラーが出ます

    • オートメーションエラーが出る場合は、繰り返し処理が多かったり、参照しているアイテムが多かったり、循環参照エラーを起こしていたりなどの原因が考えられますので、範囲を最小限にして同じエラーがでるかテストいただけますでしょうか。

  • 一つ質問です
    現在時間帯シフトから、人件費、経費などの時間帯損益を出す作業に取り掛かっています
    別シートに経費計算などのシートを作成し それとシフト表をリンクさせてます
    ここで問題が一つです
    該当するセルの値の行を参照してその行の一つ下の値を取得するといことです
    xLOOKU 関数を使いたいところですが バージョンにより使えないとのことで
    INDEX   (MATCH(   )+1)を使おうとおもいます
    そこで問題は
    +INDEX(シフト!C10:シフト!C150,MATCH(‘シート1’!A1,シフト!A11:A150,0)+1)
    まあ、問題なく取得できましたが、これではC10:C150の列しか対象にならずです
    対象としたいのはAからAG列までです
    VLOOKUPで
    IFERROR(VLOOKUP($A$1,シフト!$A:$AG,$C$1,0),””)このように書いているのですが A1 の値でシフト表のAからAG列の三列目の値を表示させてます
    三列目の値を取得するのは C1 の値で3が入れてあります C1の値を4にすると
    4列目の値を取得するということにしているのですが
    このように対象行の3番目、4番目・・ とC1の値が変るごとに
    対象行、対象列のセルの一つ下の値を取得したいのですが
    よろしくお願いいたします

    • いつもご利用ありがとうございます。

      ご質問の「C1の値が変るごとに対象行、対象列のセルの一つ下の値を取得したい」ですが、
      C1の値が4の場合、A4:AG最終行までを、5の場合A5:AG最終行までを範囲とするイメージでよろしいでしょうか。
      この場合、INDIRECT関数を利用すれば可能となります。
      以下サンプルとなります。
      VLOOKUP(A1,INDIRECT(“A”& C1 &”:AG最終行”),$C1,0)

      よろしくお願いいたします。

      • いろいろ検証しておりましたら 返事が遅くなりました
        そのような感じよいような動きをしております
        まだいろいろ検証してみることにいたします
        最近では石米のシートに 関数が多すぎて 全体が重たいといいった
        現象に悩まされています 関数、計算式などなど見直しております

        • 関数の数が増えれば処理件数も増えますので
          動作が重くなるのは仕方がないところですね…

          データ量を減らしたり、
          計算結果を値貼り付けで固定値へ変換したり、
          ある程度手を加える必要があるかもしれません。

          • ありがとうございます、やはりそうなりますね
            そこで一部をBVAで処理するようにしようかなと考えています
            セルの変更でVBA発動と ワークシーイベント?セルイベント?
            Sub test()
            Range.(“A6”).Formula = “=+IFERROR(INDEX(シフト!$A$1:$AG$129,MATCH($A11,シフト!$A$1:$A$129,0)-1,MATCH($B$7,シフト!$A$8:$AG$8,0)),””)”
            End Sub
            とまあここまでは コマンドボタンでできるのですが
            セルA1の変更で セルA6に式をいれて 値だけを残したいのですが
            どのようにしたらよいでしょうか?
            また、この方法は有効でしょうか?

          • セルA1の変更でセルA6に式をいれてA6の値だけ残す件につきまして、
            ご提示いただいたVBAに以下を追記すればよいかと思います。
            Range(“<値を残したいセル>”) = Range(“A6”).Value

            よろしくお願いいたします。

  • 早速 相談完成かと思われましたが 、少し不便が出ました
    ユーザーフォームを表示しリストボックスクリック時値ははいります
    問題なし
    この後の動作で マウスでセルを移動するのですが 矢印での移動も可能にしたいのですが 入力後フォーカスをセルに持っていき自由に移動したいのですが
    ユーザーフォーム表示
    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
    の時間を取得できないかと 複雑すぎて説明ができなくなりました
    すいません

  • コメントを残す

    メールアドレスが公開されることはありません。 * が付いている欄は必須項目です