一括で操作したいので、指定したセルに色を塗り、結合後に文字を入れたい

24時間営業のカウンター席の稼働と売上を添付のように作成しております。
レジのデータより、入店時刻と退店時刻を15分単位に直して手入力で作業してまいりましたが、
一度に作成できないかと思っております。
添付のエクセルは非表示で0:15から0:00まで15分単位で時刻が入っています。
指定時間のセルを結合し、その中に数字を入れたいです。


レジのデータは下記の形で来ます。
A 　　B 　　　C 　　D 　E
日付 テーブルNo　入店時間 退店時間 金額

並べ替えたデータは
　A 　　　B 　　　　C 　D　　E 　F G 　H 　I　 J K
日付 テーブルNo1 入店 退店 金額 入店 退店　金額 入店 退店 金額
テーブルNo2 入店 退店 金額
テーブルNo3 入店 退店 金額 入店 退店　金額 入店 退店　金額 入店 退店　金額

日付やテーブルNo等は店舗によって違います。

自分で作成したVBAはただ色を塗るだけのものでデータ並び替え等意味がないものでしたので、
ぜひともお助けいただきたいと思っております。

どうぞよろしくお願い致します。

質問者からの補足コメント

• ご連絡ありがとうございます！
  ①「レジのデータ」のシート名は？
  ⇒「データ」です。前回の説明で、ナンバリングが抜けておりました。
  その後H=FLOOR、I=CEILING計算式を入れて15分単位に直しております。※添付画像
  ② １つのテーブルで重なった時は？ 　
  ⇒データ1つに付き15分単位にして、例として10:30迄と10:30からとして重ならないようにしております。
  下図のようなレイアウトはいかがでしょうか？⇒理想通りです。
  ③ セル結合して中に入る数字は？ ⇒金額です。
  ④ 最終の表のシート名は何ですか？ ⇒「稼働表」です。
  ⑤ テーブル数を自動で増減した方が良いですか？⇒自動で増減でお願い致します。
  ⑥ フォントは？⇒フォント：メイリオ　サイズ：10です。
  本当に困っておりましたのでとてもうれしいです。
  大変お手数をお掛け致しますが、どうぞよろしくお願い致します。

  
    補足日時：2020/01/30 09:43

• ①「データ」シートは１時的に「テーブルNo.」などでソートしても良いですか？
  ⇒シートしても大丈夫です。
  ② 日付をまたぐデータが有りますが「日付」のデータの方だけに載せれば良いのですか？
  ⇒当日と翌日の表に載せ、当日に0、翌日に金額でお願い致します。
  　 それとも当日と翌日の表に載せ、当日に全額、翌日は 0 として載せる？など、どうしますか？
  ③「データ」シートの D・E列に日付のデータは残っていますか？例えば D1 セルなどを選択した状態で数式バーにはなんと表示されていますか？
  ⇒12:51:00と表示されます。
  ④「データ」シートと「稼働表」シートは同じブックに有るとして扱って良いですか？*
  ⇒同じブック内に存在しております。

    補足日時：2020/01/30 12:09

• ②は「当日と翌日の表に載せ、当日に0、翌日に金額」「当日と翌日の表に載せ、当日に全額、翌日は 0 」のどちらでも良いという事でしょうか？
  ⇒「当日と翌日の表に載せ、当日に0、翌日に金額」でお願い致します。
  私の打ち間違えで混乱させてしまい申し訳ございません。
  
  個人的には「稼働表」の最終列に有る「売上」の欄との整合性を取るために「当日と翌日の表に載せ、当日に全額、翌日は 0 」の方が良いと思いますが、いかがでしょうか？
  ⇒上長より、退転時間で売上を見たいとご要望がございまして…申し訳ございません。

    補足日時：2020/01/30 12:44

• 最終列の売上は当日と翌日のどちらに含めれば良いのでしょうか？
  ⇒翌日でお願い致します。
  
  こちらこそ煩わせてしまい申し訳ございません。よろしくお願い致します。

    補足日時：2020/01/30 13:40

• ご連絡ありがとうございます。修正版をマクロ実行してみましたらエラー400のメッセージが出まして、データシートは白紙になってしまいます。現在「データ」と「稼働表」のみでテストを行っております。私の設定箇所が間違っておりますでしょうか？

    補足日時：2020/01/31 11:40

• 問題なく操作できました。自分のミスでした。申し訳ございません！！

    補足日時：2020/01/31 12:13

No.7 ベストアンサー 回答者： GooUserラック 回答日時： 2020/01/31 09:50

修正版です。

お試しください。

Sub 稼働表作成()

Dim 元行 As Long
Dim 元終 As Long
Dim 先行 As Long
Dim 先列 As Long
Dim 時間 As Long
Dim 色① As Long
Dim 色② As Long

　色① = RGB(204, 255, 255)
　色② = RGB(255, 255, 204)
　Sheets("データ").Select
　
　Columns("B:G").Sort _
　　Key1:=Range("D1"), Order1:=xlAscending, _
　　Key2:=Range("E1"), Order2:=xlAscending, _
　　Header:=xlNo
　Columns("B:G").Sort _
　　Key1:=Range("B1"), Order1:=xlAscending, _
　　Key2:=Range("C1"), Order2:=xlAscending, _
　　Header:=xlNo
　
　Columns("J:O").Clear
　先行 = 1
　For 元行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　先行 = 先行 + 1
　　Cells(先行, 10).Value = Cells(元行, 1).Value
　　Cells(先行, 11).Value = Cells(元行, 2).Value
　　Cells(先行, 12).Value = Cells(元行, 3).Value
　　Cells(先行, 13).Value = Int(Cells(元行, 4).Value * 96 + 2)
　　If Cells(元行, 4).Value < Cells(元行, 5).Value Then
　　　Cells(先行, 14).Value = Int(Cells(元行, 5).Value * 96 + 2.9999999)
　　　Cells(先行, 15).Value = Cells(元行, 7).Value
　　Else
　　　Cells(先行, 14).Value = 99
　　　Cells(先行, 15).Value = 0
　　　先行 = 先行 + 1
　　　Cells(先行, 10).Value = Cells(元行, 1).Value
　　　Cells(先行, 11).Value = Cells(元行, 2).Value + 1
　　　Cells(先行, 12).Value = Cells(元行, 3).Value
　　　Cells(先行, 13).Value = 2
　　　Cells(先行, 14).Value = Int(Cells(元行, 5).Value * 96 + 2.9999999)
　　　Cells(先行, 15).Value = Cells(元行, 7).Value
　　End If
　Next
　Columns("J:O").Sort _
　　Key1:=Range("N1"), Order1:=xlAscending, _
　　Header:=xlYes
　Columns("J:O").Sort _
　　Key1:=Range("K1"), Order1:=xlAscending, _
　　Key2:=Range("L1"), Order2:=xlAscending, _
　　Key3:=Range("M1"), Order3:=xlAscending, _
　　Header:=xlYes
　元終 = Cells(Rows.Count, 11).End(xlUp).Row
　Sheets("稼働表").Select
　With Cells
　　.Clear
　　.ColumnWidth = 0
　　.RowHeight = 0
　　.Interior.Color = vbWhite
　　.ShrinkToFit = True
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　End With
　With Columns("A:CZ")
　　.Font.Name = "メイリオ"
　　.Font.Size = 10
　　.ColumnWidth = 1.5
　　.RowHeight = 15
　End With
　Range("A1").Select
　Range("3:3,5:5,7:7").RowHeight = 5.25
　For 先列 = 2 To 98 Step 4
　　Cells(2, 先列).Value = 時間
　　Range(Cells(2, 先列), Cells(2, 先列 + 1)).MergeCells = True
　　Cells(8, 先列).Value = 時間
　　Range(Cells(8, 先列), Cells(8, 先列 + 1)).MergeCells = True
　　時間 = 時間 + 1
　Next
　For 先列 = 3 To 95 Step 4
　　With Range(Cells(3, 先列), Cells(7, 先列 + 3))
　　　.Borders.Weight = xlThin
　　　.Borders(xlInsideVertical).LineStyle = xlDot
　　　.Borders(xlInsideHorizontal).LineStyle = xlNone
　　End With
　Next
　Range("CV2").Value = "売上"
　Range("A3:A7,CV2:CY2,CV3:CY7").MergeCells = True
　Range("A3:A7,B3:B7,CU3:CU7,CV3:CY7").Borders.Weight = xlThin
　Range("B3:B7,CU3:CU7").Borders(xlInsideHorizontal).LineStyle = xlNone
　With Range("A1:X1")
　　.RowHeight = 22.5
　　.Font.Size = 14
　　.HorizontalAlignment = xlLeft
　　.MergeCells = True
　　.NumberFormatLocal = "[DBNum3][$-411]""日付：""yyyy""年""m""月""d""日"""
　End With
　Range("CV3:CY7").Font.Size = 14
　Range("A3:A7").Select
　
　With Sheets("データ")
　　先行 = 0
　　For 元行 = 2 To 元終
　　　If .Cells(元行, 11).Value <> .Cells(元行 - 1, 11).Value Then
　　　　先行 = 先行 + 9
　　　　Rows("1:8").Copy Cells(先行, 1)
　　　　Cells(先行, 1).Value = .Cells(元行, 11).Value
　　　　Cells(先行 + 2, 1).Value = .Cells(元行, 12).Value
　　　　先行 = 先行 + 2
　　　Else
　　　　If .Cells(元行, 12).Value <> .Cells(元行 - 1, 12).Value Then
　　　　　先行 = 先行 + 5
　　　　　Rows("3:7").Copy
　　　　　Rows(先行).Insert Shift:=xlDown
　　　　　Cells(先行, 1).Value = .Cells(元行, 12).Value
　　　　End If
　　　End If
　　　Cells(先行, 100).Value = Cells(先行, 100).Value + .Cells(元行, 15).Value
　　　If .Cells(元行, 10).Value Mod 2 = 0 Then
　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Interior.Color = 色①
　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　Range(Cells(先行 + 1, .Cells(元行, 13).Value), Cells(先行 + 1, .Cells(元行, 14).Value)).MergeCells = True
　　　Else
　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Interior.Color = 色②
　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　Range(Cells(先行 + 3, .Cells(元行, 13).Value), Cells(先行 + 3, .Cells(元行, 14).Value)).MergeCells = True
　　　End If
　　Next
　　Rows("1:8").Delete Shift:=xlUp
　　.Columns("J:O").Clear
　End With

End Sub

この回答へのお礼

本当にお世話になりました。感謝致します。年配の方もこれで苦しまずに済みます。お力添えのお蔭で数か月間悩んで苦しんだことから解放されます。心からお礼を申し上げます。また何かございましたら、よろしくお願い致します。

お礼日時：2020/01/31 13:09

No.6 回答者： GooUserラック 回答日時： 2020/01/31 08:33

まだ途中ですが以下のような感じはいかがでしょうか？

※ 最終列の売上が空欄 ⇒ 修正予定
※ 日をまたぐデータの色を合わせる ⇒ 修正予定
※ お試しいただいて上記以外の問題が有るなら言ってください

文字数オーバーの為に分割（前半）

Sub 稼働表作成()

Dim 元行 As Long
Dim 元終 As Long
Dim 先行 As Long
Dim 先列 As Long
Dim 時間 As Long
Dim 色① As Long
Dim 色② As Long

　色① = RGB(204, 255, 255) ' 好きな色に変更して下さい
　色② = RGB(255, 255, 204) ' 好きな色に変更して下さい
　Sheets("データ").Select
　Columns("K:O").Clear
　先行 = 1
　For 元行 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　先行 = 先行 + 1
　　Cells(先行, 11).Value = Cells(元行, 2).Value ' 日付
　　Cells(先行, 12).Value = Cells(元行, 3).Value ' テーブルNo
　　Cells(先行, 13).Value = Int(Cells(元行, 4).Value * 96 + 2) ' 開始列
　　If Cells(元行, 4).Value < Cells(元行, 5).Value Then
　　　Cells(先行, 14).Value = Int(Cells(元行, 5).Value * 96 + 2.9999999) ' 終了列
　　　Cells(先行, 15).Value = Cells(元行, 7).Value ' 売上
　　Else
　　　Cells(先行, 14).Value = 99 ' 終了列
　　　Cells(先行, 15).Value = 0 ' 売上
　　　先行 = 先行 + 1
　　　Cells(先行, 11).Value = Cells(元行, 2).Value + 1 ' 日付
　　　Cells(先行, 12).Value = Cells(元行, 3).Value ' テーブルNo
　　　Cells(先行, 13).Value = 2 ' 開始列
　　　Cells(先行, 14).Value = Int(Cells(元行, 5).Value * 96 + 2.9999999) ' 終了列
　　　Cells(先行, 15).Value = Cells(元行, 7).Value ' 売上
　　End If
　Next
　Columns("K:O").Sort _
　　Key1:=Range("N1"), Order1:=xlAscending, _
　　Header:=xlYes
　Columns("K:O").Sort _
　　Key1:=Range("K1"), Order1:=xlAscending, _
　　Key2:=Range("L1"), Order2:=xlAscending, _
　　Key3:=Range("M1"), Order3:=xlAscending, _
　　Header:=xlYes
　元終 = Cells(Rows.Count, 11).End(xlUp).Row
　Sheets("稼働表").Select
　With Cells
　　.Clear
　　.ColumnWidth = 0
　　.RowHeight = 0
　　.Interior.Color = vbWhite
　　.ShrinkToFit = True
　　.HorizontalAlignment = xlCenter
　　.VerticalAlignment = xlCenter
　End With
　With Columns("A:CZ")
　　.Font.Name = "メイリオ"
　　.Font.Size = 10
　　.ColumnWidth = 1.5
　　.RowHeight = 15
　End With
　Range("A1").Select
　Range("3:3,5:5,7:7").RowHeight = 5.25
　For 先列 = 2 To 98 Step 4
　　Cells(2, 先列).Value = 時間
　　Range(Cells(2, 先列), Cells(2, 先列 + 1)).MergeCells = True
　　Cells(8, 先列).Value = 時間
　　Range(Cells(8, 先列), Cells(8, 先列 + 1)).MergeCells = True
　　時間 = 時間 + 1
　Next
　For 先列 = 3 To 95 Step 4
　　With Range(Cells(3, 先列), Cells(7, 先列 + 3))
　　　.Borders.Weight = xlThin
　　　.Borders(xlInsideVertical).LineStyle = xlDot
　　　.Borders(xlInsideHorizontal).LineStyle = xlNone
　　End With
　Next
　Range("CV2").Value = "売上"
　Range("A3:A7,CV2:CY2,CV3:CY7").MergeCells = True
　Range("A3:A7,B3:B7,CU3:CU7,CV3:CY7").Borders.Weight = xlThin
　Range("B3:B7,CU3:CU7").Borders(xlInsideHorizontal).LineStyle = xlNone
　With Range("A1:X1")
　　.RowHeight = 22.5
　　.Font.Size = 14
　　.HorizontalAlignment = xlLeft
　　.MergeCells = True
　　.NumberFormatLocal = "[DBNum3][$-411]""日付：""yyyy""年""m""月""d""日"""
　End With
　Range("CV3:CY7").Font.Size = 14
　Range("A3:A7").Select

No.5 回答者： GooUserラック 回答日時： 2020/01/31 08:32

まだ途中ですが以下のような感じはいかがでしょうか？

※ 最終列の売上が空欄 ⇒ 修正予定
※ 日をまたぐデータの色を合わせる ⇒ 修正予定
※ お試しいただいて上記以外の問題が有るなら言ってください

文字数オーバーの為に分割（後半）

　With Sheets("データ")
　　先行 = 0
　　For 元行 = 2 To 元終
　　　If .Cells(元行, 11).Value <> .Cells(元行 - 1, 11).Value Then
　　　　先行 = 先行 + 9
　　　　Rows("1:8").Copy Cells(先行, 1)
　　　　Cells(先行, 1).Value = .Cells(元行, 11).Value
　　　　Cells(先行 + 2, 1).Value = .Cells(元行, 12).Value
　　　　If 元行 Mod 2 = 0 Then
　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Interior.Color = 色①
　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　Range(Cells(先行 + 3, .Cells(元行, 13).Value), Cells(先行 + 3, .Cells(元行, 14).Value)).MergeCells = True
　　　　Else
　　　　　Cells(先行 + 5, .Cells(元行, 13).Value).Interior.Color = 色②
　　　　　Cells(先行 + 5, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　Range(Cells(先行 + 5, .Cells(元行, 13).Value), Cells(先行 + 5, .Cells(元行, 14).Value)).MergeCells = True
　　　　End If
　　　　先行 = 先行 + 2
　　　Else
　　　　If .Cells(元行, 12).Value <> .Cells(元行 - 1, 12).Value Then
　　　　　先行 = 先行 + 5
　　　　　Rows("3:7").Copy
　　　　　Rows(先行).Insert Shift:=xlDown
　　　　　Cells(先行, 1).Value = .Cells(元行, 12).Value
　　　　　If 元行 Mod 2 = 0 Then
　　　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Interior.Color = 色①
　　　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　　Range(Cells(先行 + 1, .Cells(元行, 13).Value), Cells(先行 + 1, .Cells(元行, 14).Value)).MergeCells = True
　　　　　Else
　　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Interior.Color = 色②
　　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　　Range(Cells(先行 + 3, .Cells(元行, 13).Value), Cells(先行 + 3, .Cells(元行, 14).Value)).MergeCells = True
　　　　　End If
　　　　Else
　　　　　If 元行 Mod 2 = 0 Then
　　　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Interior.Color = 色①
　　　　　　Cells(先行 + 1, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　　Range(Cells(先行 + 1, .Cells(元行, 13).Value), Cells(先行 + 1, .Cells(元行, 14).Value)).MergeCells = True
　　　　　Else
　　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Interior.Color = 色②
　　　　　　Cells(先行 + 3, .Cells(元行, 13).Value).Value = .Cells(元行, 15).Value
　　　　　　Range(Cells(先行 + 3, .Cells(元行, 13).Value), Cells(先行 + 3, .Cells(元行, 14).Value)).MergeCells = True
　　　　　End If
　　　　End If
　　　End If
　　Next
　　Rows("1:8").Delete Shift:=xlUp
　　.Columns("K:O").Clear
　End With

End Sub

この回答へのお礼

本当にお世話になりました。感謝致します。年配の方もこれで苦しまずに済みます。お力添えのお蔭で数か月間悩んで苦しんだことから解放されます。心からお礼を申し上げます。また何かございましたら、よろしくお願い致します。

お礼日時：2020/01/31 12:17

No.4 回答者： GooUserラック 回答日時： 2020/01/30 12:49

何度も申し訳ございません。

最終列の売上は当日と翌日のどちらに含めれば良いのでしょうか？

No.3 回答者： GooUserラック 回答日時： 2020/01/30 12:37

しつこいようで申し訳ありません

②は「当日と翌日の表に載せ、当日に0、翌日に金額」「当日と翌日の表に載せ、当日に全額、翌日は 0 」のどちらでも良いという事でしょうか？
個人的には「稼働表」の最終列に有る「売上」の欄との整合性を取るために「当日と翌日の表に載せ、当日に全額、翌日は 0 」の方が良いと思いますが、いかがでしょうか？

No.2 回答者： GooUserラック 回答日時： 2020/01/30 11:05

①「データ」シートは１時的に「テーブルNo.」などでソートしても良いですか？

② 日付をまたぐデータが有りますが「日付」のデータの方だけに載せれば良いのですか？
　 それとも当日と翌日の表に載せ、当日に全額、翌日は 0 として載せる？など、どうしますか？
③「データ」シートの D・E列に日付のデータは残っていますか？例えば D1 セルなどを選択した状態で数式バーにはなんと表示されていますか？
④「データ」シートと「稼働表」シートは同じブックに有るとして扱って良いですか？

No.1 回答者： GooUserラック 回答日時： 2020/01/30 05:06

一応確認ですが

①「レジのデータ」とはどこかのシートに書かれているのですよね？シート名は何ですか？
② １つのテーブルで重なる事もありそうですが、重なった時はどうするのでしょうか？
　 下図のようなレイアウトはいかがでしょうか？
③ セル結合して中に入る数字は「時間」・「金額」のどちらですか？
④ 最終の表のシート名は何ですか？
⑤ テーブル席の数に合わせてテーブル数を自動で増減した方が良いですか？それとも固定数が良いですか？固定の場合はいくつにしますか？
⑥ フォントの名前と大きさは何にする予定ですか？