[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『救急出動の時間計算です。』（ピーポ）
救急出動すると、事務として１件につき10分計上されます。 出動が続くと、連続して10分の事務が取れないため、次へと繰り越されます。 (例) 9:00〜10:00(10:00〜10:10) 11:00〜11:30(11:30〜11:35) 11:35〜12:30(12:30〜12:35、12:35〜12:45) このとき、出動時間、帰隊時間、事務開始時間、事務終了時間、これらをエクセルで計算できるようにしたいです。 繰越がある関係でとても複雑化してしまいます。なにか良い方法ご存じないでしょうか。 例では繰越が１件だけですが、出動が続くと数分の事務が足して10分になるまで小刻みに出現するようになります。 頭で計算するのは簡単ですが、どのようにエクセルで組み立てれば良いか路頭に迷っております。ご回答のほど、よろしくお願いいたします。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
（隠居Z） 2024/10/12(土) 19:24:13
サンプルをもうすこし挙げてください。 より複雑なものも一つ上げてもらうと回答が集まりやすいと思います。 そして大切なのは、「行番号と列番号がわかる」形式で、具体的に示すことです。
（xyz） 2024/10/12(土) 19:36:01
コメントありがとうございます。もう少しサンプルをとありましたので、なんとなく記載してみます。 入力データはこんな感じです。 出動番号 指令 帰隊 １ 9:00 10:00 ２ 11:00 11:30 ３ 11:35 12:30 ４ 12:30 13:20 ５ 13:22 14:10 ６ 16:10 17:30 これを別シートで表示させて、最終的にはこうしたいです。 １号出動時間 9:00〜10:00 １号事務時間 10:00〜10:10 ２号出動時間 11:00〜11:30 ２号事務時間 11:30〜11:35 ３号出動時間 11:35〜12:30 ４号出動時間 12:30〜13:20 ２号事務時間 13:20〜13:22 ５号出動時間 13:22〜14:10 ２号事務時間 14:10〜14:13 ３号事務時間 14:13〜14:23 ４号事務時間 14:23〜14:33 ５号事務時間 14:33〜14:43 ６号出動時間 16:10〜17:30 ６号事務時間 17:30〜17:40 結果的にこのような形で出動の時間とそれに応じた事務時間(10分まで)が表示されるようにしたいです。 ちなみに、勤務体系的には8:30スタートで、翌日昼の12:00までくらい。 １号の事務が終えられるまでに、多くても５件くらいしか連続しないと思います。
（ピーポ） 2024/10/12(土) 23:34:53
力ずくで書いてみました。美しくはないです。どなたかきっともっと良いものが提示されるでしょう。 余り詳細を検討していませんので、バグがあったら失礼。（小数点誤差回りが怪しいかも） なお、24：00を超える時刻は、25：00などと入力してください。
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow As Long
Dim t As Date
Dim t1 As Date
Dim t2 As Date
Dim k&, j&
Dim min10 As Date
Dim p As Long
Set ws1 = Worksheets("sheet1") '■シート名適宜修正
Set ws2 = Worksheets("sheet2") '■シート名適宜修正
lastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ReDim 間隔(2 To lastRow) As Date
ReDim last(2 To lastRow) As Date
ReDim myTime(2 To lastRow) As Date '事務時間の10分未達時間
ws2.Columns("A:B").ClearContents
min10 = TimeSerial(0, 10, 0)
With ws1
'出動から次の出動までの間隔
For k = 2 To lastRow
間隔(k) = .Cells(k + 1, "B") - .Cells(k, "C") '
last(k) = .Cells(k, "C")
Next
間隔(lastRow) = TimeSerial(1, 0, 0)
'各出動の事務時間10分を各間隔の上から順次割当て行く
For k = 2 To lastRow
myTime(k) = min10
For j = k To lastRow - 1
t = Application.Min(CDbl(間隔(j)), CDbl(myTime(k))) '事務充当時間
If t > 0 Then
t1 = last(j)
t2 = last(j) + t
Call writedata(p, k, t1, t2)
間隔(j) = 間隔(j) - t
myTime(k) = myTime(k) - t
last(j) = t2
End If
If myTime(k) < TimeSerial(0, 0, 1) Then Exit For
Next
Next
For k = 2 To lastRow
If myTime(k) > 0 Then
Call writedata(p, k, last(lastRow), last(lastRow) + myTime(k))
last(lastRow) = last(lastRow) + myTime(k)
End If
Next
'出動情報の書き出し
For k = 2 To lastRow
Call writedata2(p, k, .Cells(k, "B"), .Cells(k, "C"))
Next
'B列でソート
With ws2
.[A1].CurrentRegion.Sort key1:=.Range("B1"), _
order1:=xlAscending, Header:=xlNo
End With
End With
End Sub
Function writedata(p As Long, k As Long, t1 As Date, t2 As Date)
With Worksheets("Sheet2")
p = p + 1
.Cells(p, "A").Value = (k - 1) & "号事務時間"
.Cells(p, "B").Value = WorksheetFunction.Text(t1, "[hh]:mm") & "〜" _
& WorksheetFunction.Text(t2, "[hh]:mm")
End With
End Function
Function writedata2(p As Long, k As Long, t1 As Date, t2 As Date)
p = p + 1
With Worksheets("Sheet2")
.Cells(p, "A").Value = (k - 1) & "号出動時"
.Cells(p, "B").Value = WorksheetFunction.Text(t1, "[hh]:mm") & "〜" _
& WorksheetFunction.Text(t2, "[hh]:mm")
End With
End Function
（xyz） 2024/10/13(日) 06:17:24
(xyz)さんでよろしかったでしょうか。 完璧です。ここまで見事に羅列できるとは感動です。 ここから先の時間外や夜間勤務の計算は数式使って自力で頑張ろうと思います。 ありがとうございました。 （隠居Z）さんもコメントありがとうございます。 少しでも事務時間を短縮して、１件でも楽に出動できるように頑張ります。 （ピーポ） 2024/10/13(日) 12:19:44
１ 9:00 10:00 ２ 11:00 11:30 ３ 11:35 次回 ４ 12:30 13:20 ５ 13:22 14:10 ６ 16:10 17:30 （別シート） １号出動時間 9:00〜10:00 １号事務時間 10:00〜10:10 ２号出動時間 11:00〜11:30 ２号事務時間 11:30〜11:35 ３号出動時間 11:35〜次回 ４号出動時間 12:30〜13:20 ２号事務時間 13:20〜13:22 ５号出動時間 13:22〜14:10 ２号事務時間 14:10〜14:13 ３・４号事務時間 14:13〜14:33 ５号事務時間 14:33〜14:43 ６号出動時間 16:10〜17:30 ６号事務時間 17:30〜17:40 次回出動は何件続いても事務が２０分です。帰隊時間が次回なら最終的に事務が２０分ですが、署に帰隊して同時刻に出動した場合は別々で１０分ずつ繰り越されます。 帰隊時間が次回の場合の追加が可能でしたらご教授いただけると幸いです。 ほんと申し訳ありませんが、お力添えをお願いいたします。 （ピーポ） 2024/10/13(日) 12:43:53
|[A] |[B] |[C] |[D]
[1]|出動番号|指令 |帰隊 |連続指令
[2]| 1|9:00 |10:00|
[3]| 2|11:00|11:30|
[4]| 3|11:35|12:20|次回
[5]| 4|12:30|13:20|
[6]| 5|13:22|14:10|
[7]| 6|16:10|17:30|次回
↑ な感じだと解らなくはないのですが。。。
何れにいたしましても私の手には余るようなので。。。なんですが。。。
整理のお手伝いだけでもと。。。m(__)m
どなたか。。。考えて下さっておられると良いですね(￣▽￣；)
何か閃きましたらまたお邪魔するかもしれません。。。← 多分無理かも＾＾；
m(__)mm(__)mm(__)m
（隠居Z） 2024/10/13(日) 20:06:39
次回出動については、次の出動時間と同じ時刻になります。 帰隊途上で出動するので、最後に次回という形で終わることはありません。 本来はこれに加えて火災や救助出動もあって、事案ごとに事務時間が変わったりしますが、それほど件数ないのでそこはなんとかしようと思っています。 （ピーポ） 2024/10/13(日) 21:38:44
ものはついで。。。とかいうではありませんか(*^^*)
出来る出来ないは別にして、この際、ご説明なさっては。。。^^;
決して強制は致しません。＾＾ｖ ← 私が出来なくともきっと
他の方が、ご提案してくださいますよ。
火災や救助出動、救急をどこで判定するかですよね
何かルールをお示し賜るのがよろしいのではと、思いますです
でわ
頑張ってくださいね。
m(__)mm(__)mm(__)m
（隠居Z） 2024/10/13(日) 21:56:38
日の高いうちは遊んでいましたww。(日曜ですし）
まずは前提と結果です。 (1)サンプル1 ・元データ 出動番号 指令 帰隊 1 9:00 10:00 2 11:00 11:30 3 11:35 次回 4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 7 17:35 次回 8 18:00 次回 9 19:00 20:00
・結果例 1号出動時 09:00〜10:00 1号事務時間 10:00〜10:10 2号出動時 11:00〜11:30 2号事務時間 11:30〜11:35 3号出動時 11:35〜次回 4号出動時 12:30〜13:20 2号事務時間 13:20〜13:22 5号出動時 13:22〜14:10 2号事務時間 14:10〜14:13 3・4号事務時間 14:13〜14:33 5号事務時間 14:33〜14:43 6号出動時 16:10〜17:30 6号事務時間 17:30〜17:35 7号出動時 17:35〜次回 8号出動時 18:00〜次回 9号出動時 19:00〜20:00 6号事務時間 20:00〜20:05 7・8・9号事務時間 20:05〜20:25
(2)サンプル2 ・元データ 出動番号 指令 帰隊 1 9:00 10:00 2 11:00 11:30 3 11:35 12:30 4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 7 24:00 25:00 8 26:00 27:00
・結果例 1号出動時 09:00〜10:00 1号事務時間 10:00〜10:10 2号出動時 11:00〜11:30 2号事務時間 11:30〜11:35 3号出動時 11:35〜12:30 4号出動時 12:30〜13:20 2号事務時間 13:20〜13:22 5号出動時 13:22〜14:10 2号事務時間 14:10〜14:13 3号事務時間 14:13〜14:23 4号事務時間 14:23〜14:33 5号事務時間 14:33〜14:43 6号出動時 16:10〜17:30 6号事務時間 17:30〜17:40 7号出動時 24:00〜25:00 7号事務時間 25:00〜25:10 8号出動時 26:00〜27:00 8号事務時間 27:00〜27:10
（xyz） 2024/10/13(日) 22:25:31
== コード記載しましたが その後修正版を書きましたのでカットします ==
# 特段のことがなければ、これでご容赦願いたい。 （xyz） 2024/10/13(日) 22:30:58
xyzさんが作成して下さったマクロで今まで大変だった作業が本当に楽になりました。
正直このままで自分としては何も問題なく使えるからいいだろうと思っていたのですが、指摘を受けてしまいまして…
色々な方法を駆使しながらチャレンジしてみましたが力及ばず。お助けいただければと思い、再投稿したします。
サンプルを下に載せます。出動から帰隊して、事務が続いていくのですが、出動番号がマイナスであった場合、次の出動が事務時間に被ってしまったとき、余った時間を出動番号がプラスのものの後ろ側にもっていくというようにしたいです。
出動と出動の間の時間で、上から順に事務を割り振っていた部分について、正の出動番号の事務を優先し、負の出動番号のものは後回しにするという感じです。ＡＩも活用してやってみたのですが、お手上げ状態でした。ごめんなさい。
お力添えを頂けると助かります。よろしくお願いいたします。
・元データ
出動番号 指令 帰隊 1 9:00 10:00 2 11:00 11:30 3 11:35 12:00 -4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 7 24:00 25:00 8 26:00 27:00 ・結果例 1号出動時 09:00〜10:00 1号事務時間 10:00〜10:10 2号出動時 11:00〜11:30 2号事務時間 11:30〜11:35 3号出動時 11:35〜12:00 2号事務時間 12:00〜12:05 3号事務時間 12:05〜12:15 4号出動時 12:30〜13:20 4号が負の出動番号 4号事務時間 13:20〜13:22 ここで８分余りが。 5号出動時 13:22〜14:10 5号は正の出動番号 5号事務時間 14:10〜14:20 番号が正の値なので優先 4号事務時間 14:20〜14:28 番号が負の値なので後回し 6号出動時 16:10〜17:30 6号事務時間 17:30〜17:40 7号出動時 24:00〜25:00 7号事務時間 25:00〜25:10 8号出動時 26:00〜27:00 8号事務時間 27:00〜27:10 （ピーポ） 2024/11/29(金) 15:31:25
１．マイナスが続くことは？あればその対処は
２．マイナスと、次回の複合の有無と対処は
３．マイナス以外は全てプラスですが最後ではなく一つだけ後回しですか
↑１．２．の場合はどの後ろに配置するとか
上記の様なプログラム条件書を実際の業務に合わせて詳細を再度ご説明賜ると
アドバイスがあるかもしれません。私の頭は既にパンク状態ですので調べては
みますが、当てにしないでくださいませ。
他の回答者様のお出ましを。引き続きお待ちくださいませ
ほんの助言まで。。。←助言になってるかどうかも疑問ですが悪しからず << _ _ >>
興味本位のひやかしじじぃで申し訳ありませんm(__)m
でわ
頑張ってくださいね。
（隠居Z） 2024/12/01(日) 19:37:50
|[A] |[B] |[C]
[1] |出動番号|指令 |帰隊
[2] | 1|9:00 |10:00
[3] | 2|11:00|11:30
[4] | 3|11:35|次回
[5] | -4|12:30|13:20
[6] | 5|13:22|14:10
[7] | 6|16:10|17:30
[8] | -7|17:35|次回
[9] | 8|18:00|次回
[10]| 9|19:00|20:00
[11]| -10|20:10|20:45
[12]| -11|21:00|21:35
[13]| 12|21:55|22:00
[14]| -13|23:10|次回
[15]| 14|23:30|次回
[16]| -15|25:00|25:40
[17]| 16|27:00|27:25
EXCELのバージョンもアップされると解決の門が
広がるかもしれませんです。^^;
（隠居Z） 2024/12/01(日) 20:05:49
隠居Zさん、確認質問ありがとうございました。
実は金曜の投稿を見逃していました。他の発言に混ざってしまっていました。 コード見たけど分かりにくいですな、他人の作ったコードはwww。
さて、今回のお題についてですが、 ・最初にマイナスなしのものを対応し、次にマイナスのものを対応する、という方針でよいと思いました。 ・ちなみに、マイナス付きのものが単独で次回グループの中にあることはないと思いますが、 次回グループ全体をマイナス扱いするということはあるかもしれない。 その時は、そのグループの最初の出動番号にマイナスをつけて下さい。 グループ全体をそのように扱います。
コードは以下です。念のため少し確認しましたが、念入りにはしていません。あしからず。
== コード提示しましたが、後ほどの改定版をご覧ください。 ====
（xyz） 2024/12/02(月) 13:53:32
2 10:05 11:00 これを作動させたところ
1号出動時 09:00〜10:00
1号事務時間 10:00〜10:05
2号出動時 10:05〜11:00
1号事務時間 11:00〜11:05
2号事務時間 11:05〜11:15
このようになってしまいます。コード見てみたのですが、勉強不足のせいもあってどこが原因なのかさっぱりでした。
もう少しお付き合い頂けると助かります。
とりあえずは元々のものでも時間管理自体は完璧に対応できているので、急ぎませんので、お時間あるときによろしくお願いいたします。
（ぴーぽ） 2024/12/02(月) 22:57:03
(1) ミスがありました。失礼しました。 コードの修正はひとまず置いて、 まずは改めて仕様を確認したいと思います。
出動番号 指令 帰隊 -1 9:00 10:00 2 10:05 11:00 3 11:13 12:00 この場合は、どうなりますか？ マイナスの効果はどこまで利くのか（つまり優先すべき相手はどれか）という点です。 「出動番号が正のものだけまず実行して、あとでまとめてマイナスだけ処理」というロジックで 対応可能なのかどうかに影響してきます。
(2)次回との関係
| マイナス表記となる部分は、搬送しなかった事案になりますので、 | 連続でマイナスになることも、マイナスの次回が続くこともあります。 | ちなみに、搬送しなかった事案は１人しか事務がつけられません。 「搬送しなかった事案は１人しか事務がつけられません。」とはどういうことですか？ 外部の者には分かりません。
| マイナス後に次回を含む場合は次回事務が全員２０分という縛りがあるので、 | 後回しにする必要はありません。 | ということは、-1号の出動が次回で、2号の出動が続いた際に後回しになってしまうのは、 | やや厳しいかもしれません。 次回があることで、ある種のグルーピングがされるわけですよね。 「その各出動ごとにマイナスであったり、プラスであったりということは無い」という理解 （先だって書きました）でよいのですか？
マイナス、およびマイナスと次回が関係するものについて、 ・どのようなパターンがありうるのか、 ・サンプルを、それぞれ得たい結果とともに提示して下さい。 パターンを尽くしてもらうと間違いがないですね。
また、隠居Zさんからの質問（サンプル）への回答は無いのですか？
（xyz） 2024/12/03(火) 09:24:25
1 9:00 10:00 2 11:00 11:30 3 11:35 次回 −4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 −7 17:35 次回 8 18:00 次回 9 19:00 20:00 −10 20:10 20:45 −11 21:00 21:35 12 21:55 22:00 −13 23:10 次回 14 23:30 次回 −15 25:00 25:40 16 27:00 27:25 −17 28:00 次回 −18 28:30 29:00 19 29:05 29:30 −20 30:00 30:30 21 30:33 31:00 −22 31:02 31:40
(結果１)
開始 終了 内容
9:00 10:00 １号出動
10:00 10:10 １号事務
11:00 11:30 ２号出動
11:30 11:35 ２号事務
11:35 12:30 ３号出動
12:30 13:20 ４号出動
13:20 13:22 ２号事務
13:22 14:10 ５号出動
14:10 14:13 ２号事務
14:13 14:33 ３，４号事務
14:33 14:43 ５号事務
16:10 17:30 ６号出動
17:30 17:35 ６号事務
17:35 18:00 ７号出動
18:00 19:00 ８号出動
19:00 20:00 ９号出動
20:00 20:05 ６号事務
20:05 20:10 ７，８，９号事務
20:10 20:45 １０号出動
20:45 21:00 ７，８，９号事務
21:00 21:35 １１号出動
21:35 21:45 １０号事務
21:45 21:55 １１号事務
21:55 22:00 １２号出動
22:00 22:10 １２号事務
23:10 23:30 １３号出動
23:30 25:00 １４号出動
25:00 25:40 １５号出動
25:40 26:00 １３，１４，１５号事務
27:00 27:25 １６号出動
27:25 27:35 １６号事務
28:00 28:30 １７号出動
28:30 29:00 １８号出動
29:00 29:05 １７，１８号事務
29:05 29:30 １９号出動
29:30 29:35 １７，１８号事務
29:35 29:45 １９号事務
30:00 30:30 ２０号出動
30:30 30:33 ２０号事務
30:33 31:00 ２１号出動
31:00 31:02 ２１号事務
31:02 31:40 ２２号出動
31:40 31:48 ２１号事務
31:48 31:55 ２０号事務
31:55 32:05 ２２号事務
となります。
(例２)
出動番号 指令 帰隊
−1 9:00 10:00
2 10:05 11:00 3 11:13 12:00 −4 12:11 12:30
(結果２)
9:00 10:00 １号出動
10:00 10:05 １号事務
10:05 11:00 ２号出動
11:00 11:10 ２号事務
11:10 11:13 １号事務
11:13 12:00 ３号出動
12:00 12:10 ３号事務
12:10 12:11 １号事務
12:11 12:30 ４号出動
12:30 12:31 １号事務
12:31 12:41 ４号事務
事務を行う人数の件ですが、３名で出動しており、基本的には全員が事務を行うのですが、不搬送のときは事務が１名のみとなります。それゆえに、不搬送（番号がマイナス）の繰越時間が抜けの時間となってしまうのが今回の修正依頼のポイントになります。11時に帰隊して、Aさんが11:00〜11:05で-1の事務をしているのに、BCさんは11:10〜11:13に２号の事務が始まるため、11:00〜11:05は何の時間？ってところです。特に夜間帯において、Aさんの不搬送事務の時間、BCさんが休憩となるので、Aさんの事務の数分休憩して、自分たちの事務を開始するのが現実的でないと指摘を受けています。
この件についてですが、理想を言えば不搬送事務は誰が行うか分からないので、D列に氏名を入力しておき、この事務はAさん、Bさんと名前を付けられればありがたいです。そうなると、−10，−11について、事務の発生する人のみ事務の時間がつくので、21:35〜21:45の時間帯において、10号事務 Aさん、11号事務 Bさん と２行での表示になれば理想です。(例３で表示します)
最初に考えていたレイアウトと色々変わってきたせいもあって、色々と後出しになってしまい申し訳ないです。
次回の絡みですが、次回を含むグループは番号にマイナスがあっても正の値として優先されます。事務を行う人数の関係で、次回出動となれば全員で事務出来るからです。正負、負正、負負、正正、これらが何件続いてもグループ全体としては正で考えます。
(例３)
出動番号 指令 帰隊
1 9:00 10:00 2 11:00 11:30 3 11:35 次回 −4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 −7 17:35 次回 8 18:00 次回 9 19:00 20:00 −10 20:10 20:45 Aさん −11 21:00 21:35 Bさん 12 21:55 22:00 −13 23:10 次回 14 23:30 次回 −15 25:00 25:40 16 27:00 27:25 −17 28:00 次回 −18 28:30 29:00 19 29:05 29:30 −20 30:00 30:30 Cさん 21 30:33 31:00 −22 31:02 31:40 Bさん
(結果)
開始 終了 内容
9:00 10:00 １号出動
10:00 10:10 １号事務
11:00 11:30 ２号出動
11:30 11:35 ２号事務
11:35 12:30 ３号出動
12:30 13:20 ４号出動
13:20 13:22 ２号事務
13:22 14:10 ５号出動
14:10 14:13 ２号事務
14:13 14:33 ３，４号事務
14:33 14:43 ５号事務
16:10 17:30 ６号出動
17:30 17:35 ６号事務
17:35 18:00 ７号出動
18:00 19:00 ８号出動
19:00 20:00 ９号出動
20:00 20:05 ６号事務
20:05 20:10 ７，８，９号事務
20:10 20:45 １０号出動
20:45 21:00 ７，８，９号事務
21:00 21:35 １１号出動
21:35 21:45 １０号事務 Aさん
21:35 21:45 １１号事務 Bさん
21:55 22:00 １２号出動
22:00 22:10 １２号事務
23:10 23:30 １３号出動
23:30 25:00 １４号出動
25:00 25:40 １５号出動
25:40 26:00 １３，１４，１５号事務
27:00 27:25 １６号出動
27:25 27:35 １６号事務
28:00 28:30 １７号出動
28:30 29:00 １８号出動
29:00 29:05 １７，１８号事務
29:05 29:30 １９号出動
29:30 29:35 １７，１８号事務
29:35 29:45 １９号事務
30:00 30:30 ２０号出動
30:30 30:33 ２０号事務 Cさん
30:33 31:00 ２１号出動
31:00 31:02 ２１号事務
31:02 31:40 ２２号出動
31:40 31:48 ２１号事務
31:48 31:55 ２０号事務 Cさん
31:48 31:58 ２２号事務 Bさん
全てのマイナス番号に氏名が入っていないのは、次回が絡むため事務を全員で行うのが理由です。
（ぴーぽ） 2024/12/03(火) 11:27:46
(例1)と(例3)の 29:30 29:35 １７，１８号事務 29:35 29:45 １９号事務
は17号が次回なので事務時間20分で↓ではないですか？
29:30 〜 29:45 １７，１８号事務 29:45 〜 29:55 １９号事務
コードは書きましたが、話が進行中で、かえってややこしくなるので、アップするのは控えます。 （まる2021） 2024/12/03(火) 13:12:07
こんな形になりました。
Option Explicit
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Const minus As String = "-" Const comma As String = "，" '全角カンマ
Sub test()
Dim found As Variant
Dim lastRow&
Dim t As Date
Dim t1 As Date
Dim t2 As Date
Dim k&, j&
Dim p&
Dim jikaiFlag As Boolean
Set ws1 = Worksheets("sheet1") '入力データシート ■シート名適宜修正
Set ws2 = Worksheets("sheet2") '結果出力シート ■シート名適宜修正
'(1)次回処理を含むかどうかを判定
Set found = ws1.Columns("C").Find(What:="次回", After:=ws1.[C1], LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If found Is Nothing Then '次回処理無し
jikaiFlag = False
Set ws3 = ws1
Else '次回処理あり
jikaiFlag = True
Set ws3 = Worksheets.Add(After:=ws1)
ws3.Name = "dummy"
Call preset '入力データを事務時間処理しやすいよう修正したデータを作成
End If
ws2.Columns("A:D").ClearContents '結果シートの初期化
ws2.Columns("A:B").NumberFormatLocal = "[h]:mm"
'(2)事務時間作成処理
lastRow = ws3.Cells(Rows.Count, "A").End(xlUp).Row
ReDim 間隔(2 To lastRow) As Date '次の出動までの時間間隔（可変）
ReDim last(2 To lastRow) As Date '事務時間の充当済みの最終時刻（可変）
ReDim myTime(2 To lastRow) As Date '事務時間の充当が必要な残り時間（可変）
With ws3
'出動から次の出動までの間隔を初期設定
For k = 2 To lastRow
間隔(k) = .Cells(k + 1, "B") - .Cells(k, "C") '
last(k) = .Cells(k, "C")
Next
間隔(lastRow) = TimeSerial(1, 0, 0) ' 最後の出動については、形式的に余裕をみて設定
'各出動の事務時間10分を各間隔の上から順次割当て行く
For k = 2 To lastRow
'必要事務時間（"次回"フラッグあり => 20分、通常 => 10分
myTime(k) = IIf(.Cells(k, "E") = "次回", TimeSerial(0, 20, 0), TimeSerial(0, 10, 0))
If Left(.Cells(k, "A"), 1) <> minus Then '出動番号が正の場合
For j = k To lastRow
t = Application.Min(CDbl(間隔(j)), CDbl(myTime(k))) '事務充当時間
If t > 0 Then
t1 = last(j)
t2 = last(j) + t
Call writedata(p, .Cells(k, "A"), t1, t2)
間隔(j) = 間隔(j) - t
myTime(k) = myTime(k) - t
last(j) = t2
End If
If myTime(k) < TimeSerial(0, 0, 1) Then Exit For '必要事務時間が0なら繰返し終了
Next
End If
Next
'出動番号が負の場合の出動に関する事務時間を後追いで設定
For k = 2 To lastRow
If Left(.Cells(k, "A"), 1) = minus Then '出動番号が負の場合
For j = k To lastRow
t = Application.Min(CDbl(間隔(j)), CDbl(myTime(k))) '事務充当時間
If t > 0 Then
t1 = last(j)
t2 = last(j) + t
Call writedata(p, Replace(.Cells(k, "A"), minus, ""), t1, t2, .Cells(k, "D"))
間隔(j) = 間隔(j) - t
myTime(k) = myTime(k) - t
last(j) = t2
End If
If myTime(k) < TimeSerial(0, 0, 1) Then Exit For
Next
End If
Next
'事務時間未作成のものがあれば追加して作成
For k = 2 To lastRow
If myTime(k) > TimeSerial(0, 0, 1) Then '端数誤差考慮
Call writedata(p, Replace(.Cells(k, "A"), minus, ""), _
last(lastRow), last(lastRow) + myTime(k), .Cells(k, "D"))
last(lastRow) = last(lastRow) + myTime(k)
End If
Next
'(3)出動情報の書き出し
Dim s As String
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If ws1.Cells(k, "C") = "次回" Then
Call writedata2(p, CStr(Abs(ws1.Cells(k, "A"))), ws1.Cells(k, "B"), ws1.Cells(k + 1, "B"))
Else
Call writedata2(p, CStr(Abs(ws1.Cells(k, "A"))), ws1.Cells(k, "B"), ws1.Cells(k, "C"))
End If
Next
'(4)A列でソート
With ws2
.[A1].CurrentRegion.Sort key1:=.Range("A1"), _
order1:=xlAscending, Header:=xlNo
End With
End With
'(5)次回あり処理のための一時的シートを削除
If jikaiFlag = True Then
Application.DisplayAlerts = False
ws3.Delete
Application.DisplayAlerts = True
End If
End Sub
'次回処理ありデータがある場合に、処理のために元データを加工したデータを別シートに作成
Sub preset()
Dim k&, p&
p = 1
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If ws1.Cells(k - 1, "C") = "次回" Then
'前回出動が"次回"flag付きなら、それぞれの出動を統合したものに修正
ws3.Cells(p, "C") = ws1.Cells(k, "C")
ws3.Cells(p, "A") = Replace(ws3.Cells(p, "A"), minus, "") _
& comma & Replace(ws1.Cells(k, "A"), minus, "")
ws3.Cells(p, "E") = "次回"
Else
p = p + 1
ws1.Cells(k, "A").Resize(1, 4).Copy ws3.Cells(p, "A")
End If
Next
End Sub
'事務時間を結果シートに書き出すためのヘルパー関数
Function writedata(p As Long, s As String, t1 As Date, t2 As Variant, Optional person As String)
With ws2
p = p + 1
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号事務"
.Cells(p, "D").Value = person
End With
End Function
'出動情報を結果シートに書き出すためのヘルパー関数
Function writedata2(p As Long, s As String, t1 As Date, t2 As Variant)
p = p + 1
With ws2
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号出動"
End With
End Function
（xyz） 2024/12/03(火) 15:16:41
欲張ってごめんなさい。
20:10 20:45 １０号出動
20:45 21:00 ７，８，９号事務
21:00 21:35 １１号出動
21:35 21:45 １０号事務 Aさん
21:35 21:45 １１号事務 Bさん
30:00 30:30 ２０号出動
30:30 30:33 ２０号事務 Cさん
30:33 31:00 ２１号出動
31:00 31:02 ２１号事務
31:02 31:40 ２２号出動
31:40 31:48 ２１号事務
31:48 31:55 ２０号事務 Cさん
31:48 31:58 ２２号事務 Bさん
この部分について、氏名が入力されているものは無記名のものが終わり次第、それぞれ事務を行うとでも言うのでしょうか、そのようにするのは難しいでしょうか。
21:35〜21:45の部分
31:48〜31:55と31:48〜31:58の部分です。
（ぴーぽ） 2024/12/03(火) 18:29:13
済みません、私はエネルギーを使い果たしましたので、 とりあえずいったんここでお暇を頂きたく思います。 他の回答者さんからの回答をお待ちください。 （xyz） 2024/12/03(火) 18:40:58
ミスっていました。再三失礼しました。 コードを差し替えています。 私としてはこれで最終です。 （xyz） 2024/12/03(火) 22:03:50
前回が最終と申し上げていますので、余滴として、追加の仕様について、少々考えてみました。
■試行錯誤の結果、こんな風になりました。
(データ) 出動番号 指令 帰隊 担当 1 9:00 10:00 2 11:00 11:30 3 11:35 次回 -4 12:30 13:20 5 13:22 14:10 6 16:10 17:30 -7 17:35 次回 8 18:00 次回 9 19:00 20:00 -10 20:10 20:45 Aさん -11 21:00 21:35 Bさん 12 21:55 22:00 -13 23:10 次回 14 23:30 次回 -15 25:00 25:40 16 27:00 27:25 -17 28:00 次回 -18 28:30 29:00 19 29:05 29:30 -20 30:00 30:30 Cさん 21 30:33 31:00 -22 31:02 31:40 Bさん
(実行結果) 開始 終了 内容 担当 9:00 10:00 1号出動 10:00 10:10 1号事務 11:00 11:30 2号出動 11:30 11:35 2号事務 11:35 12:30 3号出動 12:30 13:20 4号出動 13:20 13:22 2号事務 13:22 14:10 5号出動 14:10 14:13 2号事務 14:13 14:33 3，4号事務 14:33 14:43 5号事務 16:10 17:30 6号出動 17:30 17:35 6号事務 17:35 18:00 7号出動 18:00 19:00 8号出動 19:00 20:00 9号出動 20:00 20:05 6号事務 20:05 20:10 7，8，9号事務 20:10 20:45 10号出動 20:45 21:00 7，8，9号事務 21:00 21:35 11号出動 21:35 21:45 10号事務 Aさん 21:35 21:45 11号事務 Bさん 21:55 22:00 12号出動 22:00 22:10 12号事務 23:10 23:30 13号出動 23:30 25:00 14号出動 25:00 25:40 15号出動 25:40 26:00 13，14，15号事務 27:00 27:25 16号出動 27:25 27:35 16号事務 28:00 28:30 17号出動 28:30 29:00 18号出動 29:00 29:05 17，18号事務 29:05 29:30 19号出動 29:30 29:45 17，18号事務 29:45 29:55 19号事務 30:00 30:30 20号出動 30:30 30:33 20号事務 Cさん 30:33 31:00 21号出動 31:00 31:02 21号事務 31:02 31:40 22号出動 31:40 31:48 21号事務 31:48 31:55 20号事務 Cさん 31:48 31:58 22号事務 Bさん
■ただし、 （前略） -17 28:00 次回 -18 28:30 29:00 19 29:05 29:30 -20 30:00 30:30 Cさん -21 30:33 31:00 Aさん -22 31:02 31:40 Bさん -23 31:40 31:50 Bさん のように不搬送（番号マイナス）をむやみに付けると
31:02 31:40 22号出動 31:40 31:50 23号出動 31:50 31:55 20号事務 Cさん 31:50 31:58 21号事務 Aさん 31:50 32:00 22号事務 Bさん 31:50 32:00 23号事務 Bさん
のように、同一担当者が同一開始時刻のものを担当することになりかねません。 これはロジックで対応するのは煩雑になりますので、 結果をチェックして不適切なものに警告を発する扱いにしました。
コードはあくまで参考としてください。
■以下、コードです。
Option Explicit Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Const minus As String = "-" Const comma As String = "，" '全角カンマ
Sub test()
Dim found As Variant
Dim lastRow&
Dim t As Date
Dim t1 As Date
Dim t2 As Date
Dim k&, j&
Dim p&
Dim jikaiFlag As Boolean
Set ws1 = Worksheets("sheet1") '入力データシート ■シート名適宜修正
Set ws2 = Worksheets("sheet2") '結果出力シート ■シート名適宜修正
'(1)次回処理を含むかどうかを判定
Set found = ws1.Columns("C").Find(What:="次回", After:=ws1.[C1], LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If found Is Nothing Then '次回処理無し
jikaiFlag = False
Set ws3 = ws1
Else '次回処理あり
jikaiFlag = True
Set ws3 = Worksheets.Add(After:=ws1)
ws3.Name = "dummy"
Call preset '入力データを事務時間処理しやすいよう修正したデータを作成
End If
p = 1 '結果シートの２行目から書き出します。★修正
ws2.Columns("A:D").ClearContents '結果シートの初期化
ws2.Range("A1:D1") = Split("開始,終了,内容,担当", ",") '項目名 ★追加
ws2.Columns("A:B").NumberFormatLocal = "[h]:mm"
'(2)事務時間作成処理
lastRow = ws3.Cells(Rows.Count, "A").End(xlUp).Row
ReDim 間隔(2 To lastRow) As Date '次の出動までの時間間隔（可変）
ReDim last(2 To lastRow) As Date '事務時間の充当済みの最終時刻（可変）
ReDim myTime(2 To lastRow) As Date '事務時間の充当が必要な残り時間（可変）
With ws3
'出動から次の出動までの間隔を初期設定
For k = 2 To lastRow
間隔(k) = .Cells(k + 1, "B") - .Cells(k, "C") '
last(k) = .Cells(k, "C")
Next
間隔(lastRow) = TimeSerial(1, 0, 0) ' 最後の出動については、形式的に余裕をみて設定
'各出動の事務時間10分を各間隔の上から順次割当て行く
For k = 2 To lastRow
'必要事務時間（"次回"フラッグあり => 20分、通常 => 10分
myTime(k) = IIf(.Cells(k, "E") = "次回", TimeSerial(0, 20, 0), TimeSerial(0, 10, 0))
If Left(.Cells(k, "A"), 1) <> minus Then '出動番号が正の場合
For j = k To lastRow
t = Application.Min(CDbl(間隔(j)), CDbl(myTime(k))) '事務充当時間
If t > 0 Then
t1 = last(j)
t2 = last(j) + t
Call writedata(p, .Cells(k, "A"), t1, t2)
間隔(j) = 間隔(j) - t
myTime(k) = myTime(k) - t
last(j) = t2
End If
If myTime(k) < TimeSerial(0, 0, 1) Then Exit For '必要事務時間が0なら繰返し終了
Next
End If
Next
'出動番号が負の場合の出動に関する事務時間を後追いで設定
For k = 2 To lastRow
If Left(.Cells(k, "A"), 1) = minus Then '出動番号が負の場合
For j = k To lastRow
t = Application.Min(CDbl(間隔(j)), CDbl(myTime(k))) '事務充当時間
If t > 0 Then
t1 = last(j)
t2 = last(j) + t
Call writedata(p, Replace(.Cells(k, "A"), minus, ""), t1, t2, .Cells(k, "D"))
'''間隔(j) = 間隔(j) - t ''★修正
myTime(k) = myTime(k) - t
'''last(j) = t2 ''★修正
End If
If myTime(k) < TimeSerial(0, 0, 1) Then Exit For
Next
End If
Next
'事務時間未作成のものがあれば追加して作成
For k = 2 To lastRow
If myTime(k) > TimeSerial(0, 0, 1) Then '端数誤差考慮
Call writedata(p, Replace(.Cells(k, "A"), minus, ""), _
last(lastRow), last(lastRow) + myTime(k), .Cells(k, "D"))
last(lastRow) = last(lastRow) + myTime(k)
End If
Next
'(3)出動情報の書き出し
Dim s As String
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If ws1.Cells(k, "C") = "次回" Then
Call writedata2(p, CStr(Abs(ws1.Cells(k, "A"))), ws1.Cells(k, "B"), ws1.Cells(k + 1, "B"))
Else
Call writedata2(p, CStr(Abs(ws1.Cells(k, "A"))), ws1.Cells(k, "B"), ws1.Cells(k, "C"))
End If
Next
'(4)A列でソート
With ws2
.[A1].CurrentRegion.Sort key1:=.Range("A1"), _
order1:=xlAscending, Header:=xlYes
End With
End With
'(5)次回あり処理のための一時的シートを削除
If jikaiFlag = True Then
Application.DisplayAlerts = False
ws3.Delete
Application.DisplayAlerts = True
End If
'(6) 同一担当者が同一開始時刻に割り当てられていないことを確認する ★★追加
Call 最終チェック
End Sub
'次回処理ありデータがある場合に、処理のために元データを加工したデータを別シートに作成
Sub preset()
Dim k&, p&
p = 1
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If ws1.Cells(k - 1, "C") = "次回" Then
'前回出動が"次回"flag付きなら、それぞれの出動を統合したものに修正
ws3.Cells(p, "C") = ws1.Cells(k, "C")
ws3.Cells(p, "A") = Replace(ws3.Cells(p, "A"), minus, "") _
& comma & Replace(ws1.Cells(k, "A"), minus, "")
ws3.Cells(p, "E") = "次回"
Else
p = p + 1
ws1.Cells(k, "A").Resize(1, 4).Copy ws3.Cells(p, "A")
End If
Next
End Sub
'事務時間を結果シートに書き出すためのヘルパー関数
Function writedata(p As Long, s As String, t1 As Date, t2 As Variant, Optional person As String)
With ws2
p = p + 1
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号事務"
.Cells(p, "D").Value = person
End With
End Function
'出動情報を結果シートに書き出すためのヘルパー関数
Function writedata2(p As Long, s As String, t1 As Date, t2 As Variant)
p = p + 1
With ws2
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号出動"
End With
End Function
'同一担当者が同一開始時刻に割り当てられていないことを確認する
Sub 最終チェック()
Dim dic As Object
Dim sName$, s$
Dim k&
Set dic = CreateObject("Scripting.Dictionary")
For k = 1 To ws2.Cells(Rows.Count, "A").End(xlUp).Row
sName = Trim(ws2.Cells(k, "D"))
If sName <> "" Then
s = sName & vbTab & Application.Text(ws2.Cells(k, "A"), "[h]:mm")
If dic.exists(s) Then
MsgBox k & "行目の" & sName & "が重複して割り当てられています。修正してください"
Else
dic(s) = Empty
End If
End If
Next
End Sub
（備考） 今回、結果シートの一行目に見出しをつけています。適当に見出し文言の修正をしてください。 従って、結果は２行目から出力します。
なお、素朴な疑問なのですが、これはどういう性格の仕事なんでしょうか。 リアルタイムに行う作業ではなく、なんらかの形式を守るために、 事後的に形を整えるためのものなんですか？ちょっと気になりました。
なお当然ながら請負契約でも何でもないので、想定外の結果となりましても責任は当方で負いかねます。 予めご承知おきください。 また、ボランティアですので、追加でこうしたことをと言われても困ります。外注先ではないので。
（xyz） 2024/12/05(木) 13:55:59
状況説明、拝読しました。
公共性の高い活動をしている人達が、こんなブラックな状況で頑張っているんですね。 エクセル使いとして、ここでお役に立てなくてどうする、との思いが湧いてきます。
正直、追加質問以前においてさえ仕様がよく分からなかったのですが、 皆さんとのやり取りを拝見して、現在は99％理解できています。
現状からの改善点は、火災・救助の対応と、24時間以上の入力方法の簡略化の2点と見ていますが、 それらは(今の処）対策が必要なレベルにはなっていない様ですね。
いずれにしましても、何か要望事項が生じた際はカンバックしてください。お助けします。
（半平太） 2024/12/06(金) 08:56:43
遅くなりました。追加の状況説明ありがとうございました。よくわかりました。 続けて要望事項があるのであれば纏めて提示されると良いと思います。 心強い多くのサポータがいらっしゃるので。
なお、今後の参考のために少し説明を加えたコードにしてみました。 若干読みやすいものになることを願っております。 （機能は変わっていないはずです。）
Option Explicit Dim ws1 As Worksheet '出動に関する入力データがあるシート Dim ws2 As Worksheet '結果を書き込むシート Dim ws3 As Worksheet '(次回処理がある場合に出動をグループ化したあとの）入力データ
Const minus As String = "-" '半角ハイフンとする Const comma As String = "，" '全角カンマとした
Dim p As Long '結果シートの書き込み用の行番号インデックス
Dim lastRow As Long '出動情報のシート(ws3)の最終行
'k番目の出動の終了時から(k+1)番目の出動開始までの期間を、k番目の「事務可能時間」と称す。 'そのk番目「事務可能時間」に関する配列 Dim 事務用開始時刻() As Date 'スタート時刻（事務充当により進行） Dim 事務用時間幅() As Date '時間幅 （事務充当により減少）
'k番目の「出動」に対応する情報 Dim 必要事務時間() As Date '今後、事務時間の充当が必要な時間（事務充当により変動）
''出動情報に基づき、事務時間を作成
Sub main()
Dim found As Variant
Dim k&, j&
Dim jikaiFlag As Boolean
Set ws1 = Worksheets("sheet1") '入力データシート ■シート名適宜修正
Set ws2 = Worksheets("sheet2") '結果出力シート ■シート名適宜修正
'(1)次回処理を含むか判定し、次回含みなら作業用ワークシートを作成
Set found = ws1.Columns("C").Find(What:="次回", After:=ws1.[C1], LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If found Is Nothing Then '次回処理無し
jikaiFlag = False
Set ws3 = ws1 '入力シートをそのまま使用
Else '次回処理あり
jikaiFlag = True
Set ws3 = Worksheets.Add(After:=ws1)
ws3.Name = "dummy"
Call 次回ありの場合のデータ変換 '事務時間作成のために出動情報をグループ化する
End If
'(2)事務時間作成処理
p = 1 '結果シートの２行目から書き出します。
ws2.Columns("A:D").ClearContents '結果シートの初期化
ws2.Range("A1:D1") = Split("開始,終了,内容,担当", ",") '見出し項目名
ws2.Columns("A:B").NumberFormatLocal = "[h]:mm"
lastRow = ws3.Cells(Rows.Count, "A").End(xlUp).Row
'k番目の出動とその次の出動との間の、「事務可能期間」に関する情報
ReDim 事務用開始時刻(2 To lastRow) As Date 'スタート時刻（事務充当により進行）
ReDim 事務用時間幅(2 To lastRow) As Date '時間幅 （事務充当により減少）
'k番目の「出動」に対応する情報
ReDim 必要事務時間(2 To lastRow) As Date '今後、事務時間の充当が必要な時間（事務充当により減少）
With ws3
'(2-1)「出動」終了から次の「出動」開始までの期間を、「事務可能期間」として初期設定
For k = 2 To lastRow
事務用開始時刻(k) = .Cells(k, "C")
事務用時間幅(k) = .Cells(k + 1, "B") - .Cells(k, "C") '
Next
事務用時間幅(lastRow) = TimeSerial(2, 0, 0) ' 形式的に余裕をみて2時間に設定
'各出動の事務時間を各「事務可能期間」から順次割当てて行く
'(2-2)出動番号が正の場合の処理を優先して実行
Call 出動番号が正のものを処理
'(2-3)出動番号が負の場合。 担当者が指定されている前提で、各担当者の並行（同時）処理を許容
Call 出動番号が負のものを処理
End With
'(3)出動情報の書き出し
With ws1
For k = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(k, "C") = "次回" Then
Call writedata2(p, myReplace(.Cells(k, "A")), _
.Cells(k, "B"), .Cells(k + 1, "B"))
Else
Call writedata2(p, myReplace(ws1.Cells(k, "A")), _
.Cells(k, "B"), .Cells(k, "C"))
End If
Next
End With
'(4)A列(開始時刻）でソート
With ws2
.[A1].CurrentRegion.Sort _
key1:=.Range("A1"), Order1:=xlAscending, Header:=xlYes
End With
'(5)次回あり処理のための一時的シートを削除
If jikaiFlag = True Then
Application.DisplayAlerts = False
ws3.Delete
Application.DisplayAlerts = True
End If
'(6) 同一担当者が同一開始時刻に割り当てられていないことを確認する
Call 最終チェック
End Sub
Sub 出動番号が正のものを処理()
'次回ありでグループ化されたものについては、既にマイナスを消去済みであることに注意する
Dim k As Long, j As Long
Dim t As Date, t1 As Date, t2 As Date
With ws3
For k = 2 To lastRow
'必要事務時間（"次回"フラッグあり => 20分、通常 => 10分 ）
必要事務時間(k) = IIf(.Cells(k, "E") = "次回", _
TimeSerial(0, 20, 0), _
TimeSerial(0, 10, 0))
If Left(.Cells(k, "A"), 1) <> minus Then
'k以降の事務可能期間から必要事務時間が満たされるまで、繰返し充当する
For j = k To lastRow
''実際の事務に充当しうる時間
t = Application.Min(CDbl(事務用時間幅(j)), CDbl(必要事務時間(k)))
If t > 0 Then
t1 = 事務用開始時刻(j)
t2 = 事務用開始時刻(j) + t
Call writedata(p, .Cells(k, "A"), t1, t2)
'事務充当に伴う更新
事務用開始時刻(j) = t2
事務用時間幅(j) = 事務用時間幅(j) - t
必要事務時間(k) = 必要事務時間(k) - t
End If
'必要事務時間が0ならjの繰返しを終了する（小数点誤差を考慮し1秒未満をゼロと見做す）
If 必要事務時間(k) < TimeSerial(0, 0, 1) Then Exit For
Next
End If
Next
End With
End Sub
Sub 出動番号が負のものを処理()
'担当者が指定されている前提で、各担当者の並行（同時）処理を許容
Dim k As Long, j As Long
Dim t As Date, t1 As Date, t2 As Date
With ws3
For k = 2 To lastRow
If Left(.Cells(k, "A"), 1) = minus Then '出動番号が負の場合
For j = k To lastRow
t = Application.Min(CDbl(事務用時間幅(j)), CDbl(必要事務時間(k)))
If t > 0 Then
t1 = 事務用開始時刻(j)
t2 = 事務用開始時刻(j) + t
Call writedata(p, myReplace(.Cells(k, "A")), t1, t2, _
.Cells(k, "D")) '担当者も書き出す
'''事務用開始時刻(j) = t2 ''あえて更新しない
'''事務用時間幅(j) = 事務用時間幅(j) - t ''あえて更新しない
必要事務時間(k) = 必要事務時間(k) - t
End If
If 必要事務時間(k) < TimeSerial(0, 0, 1) Then Exit For
Next
End If
Next
End With
End Sub
'次回処理ありデータがある場合に、後続処理のために元データを加工したデータを別シートに作成
'A列:出動番号、B列:指令時刻、C列:帰隊時刻、D列:担当、E列:次回フラッグ
Sub 次回ありの場合のデータ変換()
Dim k&, p&
p = 1
For k = 2 To ws1.Cells(Rows.Count, "A").End(xlUp).Row
If ws1.Cells(k - 1, "C") = "次回" Then
'前回出動が"次回"flag付きなら、それぞれの出動を統合したものに修正
ws3.Cells(p, "C") = ws1.Cells(k, "C") '上書きなので、最後の帰隊時刻だけが残る
ws3.Cells(p, "A") = myReplace(ws3.Cells(p, "A")) _
& comma & myReplace(ws1.Cells(k, "A")) 'マイナスを消去して連結
ws3.Cells(p, "E") = "次回" '作業用フラッグ
Else
p = p + 1
ws1.Cells(k, "A").Resize(1, 4).Copy ws3.Cells(p, "A")
End If
Next
End Sub
Function myReplace(s As String) As String
myReplace = Replace(s, minus, "")
End Function
'事務時間を結果シートに書き出すためのヘルパー関数
Function writedata(p As Long, s As String, t1 As Date, t2 As Variant, _
Optional person As String)
With ws2
p = p + 1
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号事務"
.Cells(p, "D").Value = person
End With
End Function
'出動情報を結果シートに書き出すためのヘルパー関数
Function writedata2(p As Long, s As String, t1 As Date, t2 As Variant)
p = p + 1
With ws2
.Cells(p, "A").Value = t1
.Cells(p, "B").Value = t2
.Cells(p, "C").Value = s & "号出動"
End With
End Function
Sub 最終チェック()
Dim dic As Object
Dim sName$, s$
Dim k&
Set dic = CreateObject("Scripting.Dictionary")
For k = 1 To ws2.Cells(Rows.Count, "A").End(xlUp).Row
sName = Trim(ws2.Cells(k, "D"))
If sName <> "" Then
s = sName & vbTab & Application.Text(ws2.Cells(k, "A"), "[h]:mm")
If dic.exists(s) Then
MsgBox k & "行目の" & sName & "が重複して割り当てられています。修正してください"
Else
dic(s) = Empty
End If
End If
Next
End Sub
（xyz） 2024/12/07(土) 21:51:58
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.