[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『時間の個数？計算』（まめ子）
久しぶりにお世話になります。
エクセルでスケジュール表を作っています。
その中で？？？になってしまい、取っ掛かりだけでも見出せたらと思い質問させていただきます。
A B C 1 日付 開始予定 予定時間 用事 2 060801 06：00 30分 打ち合わせ 3 060801 06：30 120分 会議 4 060801 12：00 120分 ミーティング 5 060801 15：00 30分 打ち合わせ 6 060801 18：00 30分 打ち合わせ 7 060801 11：00 30分 食事会 8 060802 18：00 30分 打ち合わせ ・ ・ 月末まで入力（変動有り） ・ ・
上のようなシートから
A B C D E F G H I J K ・・・・・ 1 日付 用事 0600 0615 0630 0645 0700 ・・・・・0545 2 060801 打ち合わせ 1 1 3 060801 会議 1 1 1 1 4 060801 ミーティング 5 060801 食事会 6 060802 打ち合わせ 7 ・ 8 ・ 続く
こんな感じのタイムスケジュールを作りたいのですが可能でしょうか？
予定が入っていたら「１」を、ダブっていた場合は「２」が表示されるようにしたいのです。
うまく説明できませんが、
どなたかお知恵をお貸しください。よろしくお願いします。
WindowsXP/Excel2000
A B C D E F G H I J K L M N O 1 日付 開始 予定 用事 6:00 6:15 6:30 6:45 7:00 7:15 7:30 7:45 8:00 8:15 8:30 2 ダブリ 1 1 2 1 1 1 1 1 1 1 1 3 060801 6:00 0:30 打ち合わせ 1 1 1 4 060801 6:30 2:00 会議 1 1 1 1 1 1 1 1 1
別シートに作成するのではなく、シートをそのまま使う。 ２行目にダブリの項目を設ける。 開始、予定等の時刻データはいずれもシリアル値で入力するものとする。 E3:=IF(AND($B3<=E$1,$B3+$C3>=E$1),1,"") で右、下へコピー E2:=COUNT(E$3:E$100) で右へコピー（100行までにしていますが範囲は調整する） (WISEMAC21)
外してるかもですが、、、
マクロで作ってみました＾＾
標準モジュールへコピペ
'---------------------------
Option Explicit
Sub mameko()
'変数の宣言
Dim MyDic As Object
Dim MyA As Variant, MyAry() As Variant, x As Variant, MyT As Variant, MyTime As Variant
Dim i As Long, n As Long, c As Long, ii As Long
With Worksheets("Sheet1") 'Sheet1で、一連の作業開始
Set MyDic = CreateObject("Scripting.Dictionary")
'Dictionaryのセット
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp)).Value
'A1からDの最終行までの値を、MyAに格納
End With 'Sheet1での、作業終了
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
MyDic(MyA(i, 1) & "," & MyA(i, 4)) = Empty
'Dictionaryに、i行目の1列と4列目を「,」でくっ付けて登録
Next i '繰り返し終了
ReDim MyAry(1 To MyDic.Count + 1, 1 To 98)
'MyAryの配列を、縦をDictionary登録分+1・横を0600～0545+項目分の98
MyAry(1, 1) = "日付" 'MyAryの(1,1)に、日付を格納
MyAry(1, 2) = "用事" 'MyAryの(1,2)に、用事を格納
MyT = TimeValue("6:00:00") 'MyTに、時間6:00を格納
For i = 3 To 98 '3～98回、繰り返し
MyAry(1, i) = "'" & Format(MyT, "hhmm")
'MyAry(1,i)に、頭に「'」を付けた時間を「hhmm」で格納
MyT = MyT + TimeValue("00:15:00")
'MyTを「00:15:00」加算
Next i '繰り返し終了
n = 1 'nに、1を格納
ii = 1 'iiに、１を格納
For Each x In MyDic.keys 'xに、DictionaryのKeyを1つずつ格納
ii = ii + 1 'iiに1を加算
n = n + 1 'ｎに1を加算
MyAry(n, 1) = "'" & Split(x, ",")(0)
'MyAry(n,1)に、頭に「'」を付けた「,」で区切りした初めの文字を格納
MyAry(n, 2) = Split(x, ",")(1) 'MyAry(n,2)に、「,」で区切りした2番目の文字を格納
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
If x = MyA(i, 1) & "," & MyA(i, 4) Then
'x(key)と、MyA(i, 1) & "," & MyA(i, 4)が同じかチェック
For c = 1 To Int(Application.Ceiling(Replace(MyA(i, 3), "分", ""), 15) / 15) + 1
'同じだったら、1～15分単位の予定時間分繰り返し
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) - 22 + c) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) - 22 + c) + 1
'開始時間から、予定時間分「1」を加算
Next c '繰り返し終了
End If '違ったらこちら
Next i '繰り返し終了
Next x '繰り返し終了
With Worksheets("Sheet2") 'Sheet2で一連の作業開始
.Cells.ClearContents '全てのセルをクリア
.Range("A1").Resize(UBound(MyAry, 1), 98) = MyAry()
'A1から必要範囲に、MyAry()を反映
.Cells.EntireColumn.AutoFit '全セル幅を調整
End With '一連の作業終了
Erase MyA, MyAry() 'MyA・MyAry()の配列解放
Set MyDic = Nothing 'Dictionaryの解放
End Sub '処理終了
（キリキ）(〃⌒o⌒)b
＞ 別シートに作成するのではなく、シートをそのまま使う。
＞ ２行目にダブリの項目を設ける。
同じシートを使い、２行目にダブり項目を入れてやってみました。
時間部分の表示はうまくいったのですが、一日で同じ項目があっ
た場合を１行にまとめたいです。このやり方だと１行にまとめられないです。
関数でそのようなことが出来ますでしょうか？
キリキ様、お返事有難うございます。
コードがとても高度な為何が起こるのかどきどきしながら実行してみたのですが、
コンパイルエラー SUB又はFANCTIONが実行されていませんと出ます。
何か最初に設定しておかなければならない事とかあるのでしょうか？？
又、コードの意味を教えていただければ嬉しいです。
ご面倒をお掛けして申し訳ありませんが、よろしくお願いします。
（まめ子）
え～と、、、 眠いので明日、時間を作ってみてみます。。。 （キリキ）（〃⌒o⌒)b AM4:35
A B C D E F G H I J K L M N O P 1 日付 開始 予定 用事 6:00 6:15 6:30 6:45 7:00 7:15 7:30 7:45 8:00 8:15 8:30 2 060801 6:00 0:30 打合せ 060801 打合せ 1 1 1 3 060801 6:30 2:00 会議 060801 会議 1 1 1 1 1 1 1 1 1 4 060801 12:00 2:00 ミーテ 060801 ミーテ 5 060801 15:00 0:30 打合せ 060801 打合せ 6 060801 18:00 0:30 打合せ 060801 打合せ 7 060801 11:00 0:30 食事会 060801 食事会 8 060802 18:00 0:30 打合せ 060802 打合せ 9 060803 6:30 2:00 会議 060803 会議 1 1 1 1 1 1 1 1 1
作業列としてE列を挿入して、E2=TEXT(A2,"yymmdd")&" "&D2 で下へコピー F2=IF(AND($B2<=F$1,$B2+$C2>=F$1),1,"") で右、下へコピー
Sheet2のA1を選択して「データ」→「統合」をクリック 「統合の設定」ダイアログボックスで集計方法→「合計」 リファレンスにデータ範囲：Sheet1!$E$1:（データの終わりまで）を選択し、「追加」ボタンをクリックして統合元に追加する。 統合の基準で上端行、左端列にチェックをして、OKボタンをクリックする。 1行目の時刻は表示形式を「h:mm」設定する。 このような方法をとれば、同じ日の用事は同一行にまとめられる。
A B C D E F G H I J K L 1 6:00 6:15 6:30 6:45 7:00 7:15 7:30 7:45 8:00 8:15 8:30 2 060801 打合せ 1 1 1 3 060801 会議 1 1 1 1 1 1 1 1 1 4 060801 ミーテ 5 060801 食事会 6 060802 打合せ 7 060803 会議 1 1 1 1 1 1 1 1 1
ダブりは同日同時刻のダブりを調べて表示するのではないかと思いますが、１ヶ月間だと１日毎にダブりを調べることになりますか？ (wisemac21)
>コンパイルエラー SUB又はFANCTIONが実行されていませんと出ます。 ちなみに、どこの部分で出ましたか？ コンパイルエラーってどういうときに出るんでしょうね・・・ 誰か教えてください＾＾； 表は下記のような感じで合ってますでしょうか？ Sheet1 [A] [B] [C] [D] [1] 日付 開始予定 予定時間 用事 [2] 060801 6:00 30分 打ち合わせ [3] 060801 6:30 120分 会議 [4] 060801 12:00 120分 ミーティング [5] 060801 15:00 30分 打ち合わせ [6] 060801 18:00 30分 打ち合わせ [7] 060801 11:00 30分 食事会 [8] 060802 18:00 30分 打ち合わせ ↑ ↑ ↑ ↑ ↑ 後ろに「分」の付いた文字列 ↑ 時間はシリアル値 頭に「0」が付いた6桁の文字列 >又、コードの意味を教えていただければ嬉しいです。 上のコードに、説明を追加しました。 ちょっとコードを変更してみました。 これでいかがなもんでしょう？ （キリキ）（〃⌒o⌒)b
お返事ありがとうございます。
（キリキ）（〃⌒o⌒)b様、
コンパイルエラーはこちらの勘違いでした（＾＾A）すいません （サブで使用しているパソコンがオフィス９７でした ｱｾｱｾｯ
実行してみたところ、以下の２行で
’実行時エラー９ インデックスに有効範囲がありません，と表示されました。
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) - 22 + c) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) - 22 + c) + 1
＞ '開始時間から、予定時間分「1」を加算
↑せっかく書いて頂いてるにどうして良いか分かりません。（＝＝;）
先程、教えて頂いたコードはキリキ様がおっしゃった様に セルの形式を変更して実行しています。
コードに
On Error Resume Next '一時的に挿入 を追加して実行したところSheet2に表は生成されたのですが数字が出てき ませんでした。 やっぱり、セルの入力に問題が有るのでしょうか？
説明では、 予定時間の「分」は表示させているだけで実際は４桁の数字 開始時間は「：」は表示させているだけで実際は４桁の数字 日付はシリアル値です と言いたかったのです・・・
説明が悪くてホントすいませんm(＞ｘ＜;)m
エラーを消すにはどうすれば良いのでしょうか？
よろしくお願いします。
(wisemac21)様、お返事有難うございます。
A B C D E F G H I J K L M N O P 1 日付 開始 予定 用事 6:00 6:15 6:30 6:45 7:00 7:15 7:30 7:45 8:00 8:15 8:30 2 060801 6:00 0:30 打合せ 060801 打合せ 1 1 1 ↑文字列 ↑シリアル ↑シリアル
にて、言われた通りコピペしてみたのですが、「1」が出てこなくなりました。
キリキ様の指摘にて気付き、データを修正して行ってみたのですが・・・
表示は上記にてよろしいのでしょうか？
＞ダブりは同日同時刻のダブりを調べて表示するのではないかと思いますが、 １ヶ月間だと１日毎にダブりを調べることになりますか？
ダブりの考え方として、１日に同じ用事が有れば時刻は関係なく 何行有っても１日括りで１行に纏めたいと思っています。
又、出張等3000分で日をまたいだりします
日をまたいだ場合は、翌日の日付の行に表示したいのですが・・・
いろいろ言ってすいませんがよろしくお願いします。
（まめ子）
>やっぱり、セルの入力に問題が有るのでしょうか？
はい。
その通りｗ
見た目と、エクセル君が認識しているものは、必ずしも一緒とは限りません。
エラーが出てきたところを、下記に変えてみてください。
MyAry(ii, Int(TimeValue(Format(Format(MyA(i, 2), "00:00"), "h:mm")) / TimeValue("00:15:00")) - 22 + c) = _
MyAry(ii, Int(TimeValue(Format(Format(MyA(i, 2), "00:00"), "h:mm")) / TimeValue("00:15:00")) - 22 + c) + 1
若しくは、シリアル値で入力してから実行してみてください。
※今後のことを考えると、数字は数字・日付は日付・時間は時間で入力するほうがいいかと思います。
（キリキ）（〃⌒o⌒)b
A列の日付はシリアル値が入力されているものとしています。 ＞「1」が出てこなくなりました A列は計算に使用していませんので、別に原因がありのでは？
業務上の1日の定義は日付ではなく始まりが６:00 amで翌日6:00 am未満までですか
＞ダブりの考え方として、１日に同じ用事が有れば時刻は関係なく何行有っても１日括りで１行に纏めたいと思っています。 ダブリとは同日の同じ用事の時刻が重なるということですね。同日に異なる用事の時刻が重なる場合はダブリとしては扱わないのでしょうか。 データの統合を使うと同じ用事のダブリは何行あっても合計されて同一行に統合されます。
＞又、出張等3000分で日をまたいだりします 出張が3000分3日にまたがりますが、もっと長い期間もありうるということですね。 （これは難しいですね。日にち毎に入力されればよいのですが・・・） (wisemac21)
お返事有難うございます。 ＞同日に異なる用事の時刻が重なる場合はダブリとしては扱わないのでしょうか。 ⇒扱いません。（移動中や合間にアポ取ったりするので・・・） 「1」が出てこなくなった原因は解決いたしました！ 色々入力している内に１行目の時間が抜けておりました（＾＾A）ｽｲﾏｾﾝ 跨るのは関数では難しいみたいなんですね・・・ （それさえクリア出来たらほぼ完璧なんですが・・・） 後、データ量がハンパ無くでっかくなってしまいました。。。 （ムボーな量を入力していたせいもあると思うのですが・・） とりあえず、跨るところは記録マクロなどを併用して頑張ってみます。
＞業務上の1日の定義は日付ではなく始まりが６:00 amで翌日6:00 am未満までですか ⇒そうです。なので最初は翌2時を「2600」と入力していました。 なので以下のような入力にしていたのです。 ◎予定時間の「分」は表示させているだけで実際は４桁の数字 ◎開始時間は「：」は表示させているだけで実際は４桁の数字 ◎日付はシリアル値 TIMEVALUE関数で変換したのでシリアル値が「1900/1/1 1:00:00」となっています。
おかげさまで表示上「1日の1：00」でもちゃんと1日の行に入ってくれてます。（＾＾）ｖ 色々、教えていただいて有難うございます。 とっても勉強になりました。
（まめ子）
（キリキ）様、お返事有難うございます。
＞※今後のことを考えると、数字は数字・日付は日付・時間は時間で入力するほうがいいかと思います。
⇒実際は以下のような状態です 予定時間の「分」は表示させているだけで実際は４桁の数字 開始時間は「：」は表示させているだけで実際は４桁の数字 日付はシリアル値
一応、私なりの理由があって 開始時間が０時を超えると「25：00」と入力すると「01：00」表記になって 分かりにくかった為「2500」等、４桁の数字にしていました。
もっと、スマートな加工用入力方法があるのでしょうか（？x？;）？？
今日一日、四苦八苦しながら色々試しているうちにエラーせずに処理が走ってくれました！！ （最初に教えていただいたコードで。。） 上記コードでの条件として、開始時間はシリアル値と言われてましたので 変換したのですが、日付含めのシリアル値に変換していた為うまく作動しなかったみたいです。
ですが、色々不明な箇所がありましたので教えていただけませんか？
① 15分以下は表示されない、又35分みたいな端数だと切り捨て表示？になってしまう。 ② 0時超えたときの結果・入力時がよく分からない。 ③ 6：00を跨ぐとエラーが出る
です。宜しければ教えてください。宜しくお願いします。
（まめ子）
＞開始時間が０時を超えると「25：00」と入力すると「01：00」表記になって分かりにくかった セルの表示形式をユーザー定義で「[h];mm」にすれば入力通りに表示されます (wisemac21)
コードちょっと修正 >15分以下は表示されない、又35分みたいな端数だと切り捨て表示？になってしまう。 変更後のこちらでいかがでしょう？ >0時超えたときの結果・入力時がよく分からない。 wisemac21さんも仰っている通り、表示形式を [h]:mm にしてください。 >6：00を跨ぐとエラーが出る こちらもwisemac21さんが触れてますが、、、 >これは難しいですね。日にち毎に入力されればよいのですが・・・ の方がよろしいかと思います。 ※なお、暫く学校にPCを使用しての書き込みできる環境がなくなります。 約1週間ぐらい？ （キリキ）（〃⌒o⌒)b
wisemac21様、キリキ様、大変素晴らしいご指導、本当に本当に有難うございます。
正直、そこまで深く考えていませんでしたので表を作った際に「この用事やったら2時間位かなぁ・・」 そんな感じで入力していました。
何か、処理とかしようと思うなら利便性の有るシンプルなデータ形式にするべきですね！
一度根本から見直します！！
お二人に御教授いただいた事象を考えて、入力時表を作るときに
[A] [B] [C] [D]
[1] 日付 開始予定 終了予定 用事
[2] 060801 6:00 7：00 打ち合わせ
[3] 060801 6:30 8：00 会議
[4] 060801 12:00 5：59 出張 ←（終了時間表示は29：59）
[5] 060802 6:00 5：59 出張 ←（終了時間表示は29：59）
[6] 060803 6:00 18：00 出張
[7] 060803 11:00 13：00 食事会
[8] 060803 18:00 20：00 打ち合わせ
↑シリアル値 ↑シリアル値 ↑シリアル値
こんな表を作ろうと思います。
よく考えたら、長時間になればなるほど分計算大変ですよね（＾＾;）
そこでしつこく質問なのですが、
wisemac21様に教えて頂いた方法では
＞F2=IF(AND($B2<=F$1,$B2+$C2>=F$1),1,"") ↑↑ 式を ↓↓式に変えてみました。 =IF(AND($B2<=F$1,$C2>=F$1),1,"")
一見、うまくいって出来て見えますがこれで宜しいのでしょうか？
キリキ様に教えて頂いたコードは。。。さすがにさっぱりなので（＾＾;）
一週間書き込みが出来ないそうですのでその間に少しでも勉強しときます。
（まめ子）
がんばれ～♪ (キリキ)（〃⌒o⌒)b
C列を終了予定時刻に変更されたので、式の変更は問題ないと思います。 (wisemac21)
※注意事項 入力用のシートの１行目のセル範囲F1:CW1のデータ入力について F1に「6:00」、G1に「=F1+"0:15"」としてオートフィルでデータを入力するような場合は、 演算誤差が出てきますので誤差対策が必要になります。（下記URL参照） http://pc.nikkeibp.co.jp/pc21/special/gosa/index.shtml
一週間考えてみたのですが、さっぱり分かりませんでした。
すいませんが教えて下さい。M(UU;)M 後、いろいろ使っているうちに９時区切りの方が使い勝手が良いので 編集しようと思ったのですが
MyT = TimeValue("6:00:00") 'MyTに、時間6:00を格納
この行以外にどこを直せばよいのでしょうか？
すいませんがおしえてください。
（まめ子）
正直、時間がたち過ぎて忘れちゃってるｗ
自分で待ってもらって、頑張れって言ったのに・・・orz
とりあえず、これで試してみてもらってもいいですか？
不具合があったら、言ってください。
（多分あると思います。。。）
Sub mameko()
'変数の宣言
Dim MyDic As Object
Dim MyA As Variant, MyAry() As Variant, x As Variant, MyT As Variant, MyTime As Variant
Dim i As Long, n As Long, c As Long, ii As Long
With Worksheets("Sheet1") 'Sheet1で、一連の作業開始
Set MyDic = CreateObject("Scripting.Dictionary")
'Dictionaryのセット
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp)).Value
'A1からDの最終行までの値を、MyAに格納
End With 'Sheet1での、作業終了
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
MyDic(MyA(i, 1) & "," & MyA(i, 4)) = Empty
'Dictionaryに、i行目の1列と4列目を「,」でくっ付けて登録
Next i '繰り返し終了
ReDim MyAry(1 To MyDic.Count + 1, 1 To 98)
'MyAryの配列を、縦をDictionary登録分+1・横を0600～0545+項目分の98
MyAry(1, 1) = "日付" 'MyAryの(1,1)に、日付を格納
MyAry(1, 2) = "用事" 'MyAryの(1,2)に、用事を格納
MyT = TimeValue("0:00:00") 'MyTに、スタート時間 0:00を格納
For i = 3 To 98 '3～98回、繰り返し
MyAry(1, i) = "'" & Format(MyT, "hhmm")
'MyAry(1,i)に、頭に「'」を付けた時間を「hhmm」で格納
MyT = MyT + TimeValue("00:15:00")
'MyTを「00:15:00」加算
Next i '繰り返し終了
n = 1 'nに、1を格納
ii = 1 'iiに、１を格納
For Each x In MyDic.keys 'xに、DictionaryのKeyを1つずつ格納
ii = ii + 1 'iiに1を加算
n = n + 1 'ｎに1を加算
MyAry(n, 1) = "'" & Split(x, ",")(0)
'MyAry(n,1)に、頭に「'」を付けた「,」で区切りした初めの文字を格納
MyAry(n, 2) = Split(x, ",")(1) 'MyAry(n,2)に、「,」で区切りした2番目の文字を格納
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
If x = MyA(i, 1) & "," & MyA(i, 4) Then
'x(key)と、MyA(i, 1) & "," & MyA(i, 4)が同じかチェック
For c = 1 To Int(Application.Ceiling(Replace(MyA(i, 3), "分", ""), 15) / 15) + 1
'同じだったら、1～15分単位の予定時間分繰り返し
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) + 1
'開始時間から、予定時間分「1」を加算
Next c '繰り返し終了
End If '違ったらこちら
Next i '繰り返し終了
Next x '繰り返し終了
With Worksheets("Sheet2") 'Sheet2で一連の作業開始
.Cells.ClearContents '全てのセルをクリア
.Range("A1").Resize(UBound(MyAry, 1), 98) = MyAry()
'A1から必要範囲に、MyAry()を反映
.Cells.EntireColumn.AutoFit '全セル幅を調整
.Columns("C:AL").Cut '0:00～8:45を後ろに切り取る
.Columns("CU:ED").Insert Shift:=xlToRight
'切り取ったものを後ろに貼り付け
End With '一連の作業終了
Erase MyA, MyAry() 'MyA・MyAry()の配列解放
Set MyDic = Nothing 'Dictionaryの解放
End Sub '処理終了
（キリキ）（〃⌒o⌒)b
おはようございます。
お返事有難うございます！＾＾！。
早速試してみました！
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) + 1
またしても、’実行時エラー９ インデックスに有効範囲がありません，と表示されました。
現在は、日付・開始・終了全てシリアル値です。
又、MyT = TimeValue("0:00:00") と表記されてますが以前のコードは6：00だったので・・
9:00:00に変更した方が良いのでしょうか？
一応エラーを無視して処理をするとSheet2の表は出ましたが正しく表示されませんでした。
色々言ってすいませんが、宜しくお願いします。
（まめ子）
>またしても、’実行時エラー９ インデックスに有効範囲がありません，と表示されました。
σ(^o^;)のエクセル君は、エラーを出しませんでしたが？
何かがこちらと違うのでしょうね。。。
>現在は、日付・開始・終了全てシリアル値です。
こう言う事になってますでしょうか？
[A] [B] [C] [D]
[1] 日付 開始予定 予定時間 用事
[2] 2006/8/1 6:00 8:00 打ち合わせ
下記に修正してみましたので、検証してみてください。
Sub mameko2()
'変数の宣言
Dim MyDic As Object
Dim MyA As Variant, MyAry() As Variant, x As Variant, MyT As Variant, MyTime As Variant
Dim i As Long, n As Long, c As Long, ii As Long
With Worksheets("Sheet1") 'Sheet1で、一連の作業開始
Set MyDic = CreateObject("Scripting.Dictionary")
'Dictionaryのセット
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp)).Value
'A1からDの最終行までの値を、MyAに格納
End With 'Sheet1での、作業終了
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
MyDic(MyA(i, 1) & "," & MyA(i, 4)) = Empty
'Dictionaryに、i行目の1列と4列目を「,」でくっ付けて登録
Next i '繰り返し終了
ReDim MyAry(1 To MyDic.Count + 1, 1 To 98)
'MyAryの配列を、縦をDictionary登録分+1・横を0600～0545+項目分の98
MyAry(1, 1) = "日付" 'MyAryの(1,1)に、日付を格納
MyAry(1, 2) = "用事" 'MyAryの(1,2)に、用事を格納
MyT = TimeValue("0:00:00") 'MyTに、スタート時間 0:00を格納
For i = 3 To 98 '3～98回、繰り返し
MyAry(1, i) = "'" & Format(MyT, "hhmm")
'MyAry(1,i)に、頭に「'」を付けた時間を「hhmm」で格納
MyT = MyT + TimeValue("00:15:00")
'MyTを「00:15:00」加算
Next i '繰り返し終了
n = 1 'nに、1を格納
ii = 1 'iiに、１を格納
For Each x In MyDic.keys 'xに、DictionaryのKeyを1つずつ格納
ii = ii + 1 'iiに1を加算
n = n + 1 'ｎに1を加算
MyAry(n, 1) = "'" & Split(x, ",")(0)
'MyAry(n,1)に、頭に「'」を付けた「,」で区切りした初めの文字を格納
MyAry(n, 2) = Split(x, ",")(1) 'MyAry(n,2)に、「,」で区切りした2番目の文字を格納
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
If x = MyA(i, 1) & "," & MyA(i, 4) Then
'x(key)と、MyA(i, 1) & "," & MyA(i, 4)が同じかチェック
For c = 1 To Application.Ceiling((MyA(i, 3) - MyA(i, 2)) / TimeValue("00:15:00") + 1, 1)
'同じだったら、1～15分単位の予定時間分繰り返し
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c) + 1
'開始時間から、予定時間分「1」を加算
Next c '繰り返し終了
End If '違ったらこちら
Next i '繰り返し終了
Next x '繰り返し終了
With Worksheets("Sheet2") 'Sheet2で一連の作業開始
.Cells.ClearContents '全てのセルをクリア
.Range("A1").Resize(UBound(MyAry, 1), 98) = MyAry()
'A1から必要範囲に、MyAry()を反映
.Cells.EntireColumn.AutoFit '全セル幅を調整
.Columns("C:AL").Cut '0:00～8:45を後ろに切り取る
.Columns("CU:ED").Insert Shift:=xlToRight
'切り取ったものを後ろに貼り付け
End With '一連の作業終了
Erase MyA, MyAry() 'MyA・MyAry()の配列解放
Set MyDic = Nothing 'Dictionaryの解放
End Sub '処理終了
（キリキ）（〃⌒o⌒)b
長々とすいません。 24：00以降の時間が入力されているとエラーになるみたいです。 24：00以降のデータが入っていないとうまくいきました！！ 時間ですが、シリアル値入力で27：00と入れてますがそれがまずいのでしょうか？ 表示は[h]:mmにしてるんですが・・
（まめ子）
>24：00以降の時間が入力されているとエラーになるみたいです。 はい。 そうなると思います。 σ(^o^;)の次の課題がソレですからｂ 今日の夜にでも家で挑戦！ では、定時になったので帰りま～す＾＾ （キリキ）（〃⌒o⌒)b
やってみました＾＾
何処まで対応できるかわかりませんが。。。
これ以上は、σ(^o^;)には荷が重過ぎるかも・・・orz
Sub mameko3()
'変数の宣言
Dim MyDic As Object
Dim MyA As Variant, MyAry() As Variant, x As Variant, MyT As Variant, MyTime As Variant
Dim i As Long, n As Long, c As Long, ii As Long, cc As Long
With Worksheets("Sheet1") 'Sheet1で、一連の作業開始
Set MyDic = CreateObject("Scripting.Dictionary")
'Dictionaryのセット
MyA = .Range("A1", .Range("D" & Rows.Count).End(xlUp)).Value
'A1からDの最終行までの値を、MyAに格納
End With 'Sheet1での、作業終了
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
MyDic(MyA(i, 1) & "," & MyA(i, 4)) = Empty
'Dictionaryに、i行目の1列と4列目を「,」でくっ付けて登録
Next i '繰り返し終了
ReDim MyAry(1 To MyDic.Count + 1, 1 To 98)
'MyAryの配列を、縦をDictionary登録分+1・横を0600～0545+項目分の98
MyAry(1, 1) = "日付" 'MyAryの(1,1)に、日付を格納
MyAry(1, 2) = "用事" 'MyAryの(1,2)に、用事を格納
MyT = TimeValue("0:00:00") 'MyTに、スタート時間 0:00を格納
For i = 3 To 98 '3～98回、繰り返し
MyAry(1, i) = "'" & Format(MyT, "hhmm")
'MyAry(1,i)に、頭に「'」を付けた時間を「hhmm」で格納
MyT = MyT + TimeValue("00:15:00")
'MyTを「00:15:00」加算
Next i '繰り返し終了
n = 1 'nに、1を格納
ii = 1 'iiに、１を格納
For Each x In MyDic.keys 'xに、DictionaryのKeyを1つずつ格納
ii = ii + 1 'iiに1を加算
n = n + 1 'ｎに1を加算
MyAry(n, 1) = "'" & Split(x, ",")(0)
'MyAry(n,1)に、頭に「'」を付けた「,」で区切りした初めの文字を格納
MyAry(n, 2) = Split(x, ",")(1) 'MyAry(n,2)に、「,」で区切りした2番目の文字を格納
For i = 2 To UBound(MyA, 1) '2～MyAの最終行まで繰り返し
If x = MyA(i, 1) & "," & MyA(i, 4) Then
'x(key)と、MyA(i, 1) & "," & MyA(i, 4)が同じかチェック
cc = 0
For c = 1 To Application.Ceiling((MyA(i, 3) - MyA(i, 2)) / TimeValue("00:15:00") + 1, 1)
'同じだったら、1～15分単位の予定時間分繰り返し
If Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c - cc > 98 Then
'もし配列以上(99)になったら
cc = 96 '帳尻合わせ用 ccに96を代入
End If 'もし終了
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c - cc) = _
MyAry(ii, Int(MyA(i, 2) / TimeValue("00:15:00")) + 2 + c - cc) + 1
'開始時間から、予定時間分「1」を加算
Next c '繰り返し終了
End If '違ったらこちら
Next i '繰り返し終了
Next x '繰り返し終了
With Worksheets("Sheet2") 'Sheet2で一連の作業開始
.Cells.ClearContents '全てのセルをクリア
.Range("A1").Resize(UBound(MyAry, 1), 98) = MyAry()
'A1から必要範囲に、MyAry()を反映
.Cells.EntireColumn.AutoFit '全セル幅を調整
Application.ScreenUpdating = False
.Columns("C:AL").Cut '0:00～8:45を後ろに切り取る
.Columns("CU:ED").Insert Shift:=xlToRight
'切り取ったものを後ろに貼り付け
Application.ScreenUpdating = True
End With '一連の作業終了
Erase MyA, MyAry() 'MyA・MyAry()の配列解放
Set MyDic = Nothing 'Dictionaryの解放
End Sub '処理終了
（キリキ）（〃⌒o⌒)b
キリキ様！！有難うございます。。 照合に時間がかかっちゃいました。
うまくいきました！！
本当に有難うございます。
一つ気になる点が。。。
出張とかで 開始「9:00」終了「32：59」が２日以上続くと ２日目の「9:00」欄がなぜか「2」になってしまいます。
特にまずいということもないので気にしてないのですが（＾＾;）
その他は、どんな時間を入れても完璧に表になりました！！
本当に有難うございます！！
（まめ子）
そうなんです。。。 二日以上の時などをどうするかが、思い付かないんですよ。。。
二行にすればいいのかな～？
時間があったら挑戦しますが、あまり期待しないでください。
(キリキ)（〃⌒o⌒)b
長々とお付き合い下さって感謝の言葉もありません！！
私には到底理解出来ないコードなので何とか理解出来るよう励みます！！
コードを作成される考え方として、実際にかかる予定時間を提示させた方が
作りやすそうですね（^^;）何となくですが・・・
（見当はずれだったらごめんなさいm(uu)m）
wisemac21様とキリキ様に教えて頂いた事を応用して使えるよう勉強に努めさせて頂きます！！
本当に有難うございます！！
（まめ子）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.