VBA Excel StartとEndの時間を分割して別行に表示させる

以下のようなデータがあります。
元データ）
A1,B1,C1,D1,E1
地域,担当,日付,start,end
A2,B2,C2,D2,E2
東京,田中,2020/5/9,16:00,18:00
A3,B3,C3,D3,E3
大阪,佐々木,2020/5/10,18:00,19:30
A4,B4...
A5以降も同様に担当別に3000行ほどあります。

このデータを隣のF列にStartとEndを30分毎に分割(地域,担当,日付はそのままで時刻のみ30分毎に分割)し、それを下の行へ追加していくことがやりたいのですがVBAで可能でしょうか。。
なお、Endの時間は一番遅くとも23:30となり、0:00をまたぐことはありません。
教えていただけると大変助かります。

変更後データ）
F1,G1,H1,I1,J1
地域,担当,日付,start,end
F2,G2,H2,I2,J2
東京,田中,2020/5/9,16:00,16:30
F3,G3,H3,I3,J3
東京,田中,2020/5/9,16:30,17:00
F4,G4,H4,I4,J4
東京,田中,2020/5/9,17:00,17:30
F5,G5,H5,I5,J5
東京,田中,2020/5/9,17:30,18:00
F6,G6,H6,I6,J6
大阪,佐々木,2020/5/10,18:00,18:30
F7,G7,H7,I7,J7
大阪,佐々木,2020/5/10,18:30,19:00
F8,G8,H8,I8,J8
大阪,佐々木,2020/5/10,19:00,19:30

F9...以降も同じパターン

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

--- 5/10 11:05 update ---
元データ）
地域担当日付 start end
東京田中 2020/5/9 16:00 18:00
大阪佐々木 2020/5/10 18:00 19:30
名古屋佐藤 2020/5/11 13:00 13:30
東京田中 2020/5/12 11:00 12:30
大阪佐々木 2020/5/13 9:00 12:00
名古屋佐藤 2020/5/14 2:00 3:00

実行後）
地域担当日付 start end
東京田中 2020/5/9 16:00 16:30
東京田中 2020/5/9 16:30 17:00
東京田中 2020/5/9 17:00 17:30
東京田中 2020/5/9 17:30 18:00
大阪佐々木 2020/5/10 18:00 18:30
大阪佐々木 2020/5/10 18:30 19:00
大阪佐々木 2020/5/10 19:00 19:30
名古屋佐藤 2020/5/11 13:00 13:30
東京田中 2020/5/12 11:00 11:30
東京田中 2020/5/12 11:30 12:00
東京田中 2020/5/12 12:00 12:30
大阪佐々木 2020/5/13 9:00 9:30
大阪佐々木 2020/5/13 9:30 10:00
大阪佐々木 2020/5/13 10:00 10:30
大阪佐々木 2020/5/13 10:30 11:00
大阪佐々木 2020/5/13 11:00 11:30
大阪佐々木 2020/5/13 11:30 12:00
名古屋佐藤 2020/5/14 2:00 2:30
名古屋佐藤 2020/5/14 2:30 3:00

coco_bauer

2020/05/10 01:52

頑張れば、VBAで大抵のことは出来ます。とこれで、Start,Endの時刻の分は、00か30のいずれかのみでしょうか？また、「A5以降も同様に担当別に」と書かれていますが、"担当別に"というのはデータがどのようになっていることを意味するのでしょうか？

pandama

2020/05/10 02:19

記載不足、失礼いたしました。はい、Start,Endの時刻の分は、30分単位の00か30のみで05や15はありません。「A5以降も同様に担当別に」は単純に担当者別に（日付,start,end)が違うものが下に続くという意味でした。地域と担当はイコールで関係性が変わることはありません。（東京は田中のみ、大阪は佐々木のみ担当）日付,start,endのみ行によって変わります。わかりにくいかもしれませんが、表を質問箇所に追記しました。上表が元データで下表が求めているVBA実行後結果となります。実際の実行結果はF-J列に反映したいです。

行動規範の内容に同意します

回答1件

ベストアンサー

端数も対応出来ていると思います。

VBA
1Sub tes01()
2  Dim TrgRang As Range
3  Dim MstRang As Range
4  Dim SetRang As Range
5  Dim Ws As Worksheet
6  Dim SpTime As Double
7  
8  SpTime = TimeValue("00:30:00") '区切り(hh:mm:ss)
9  
10  Set Ws = ThisWorkbook.Worksheets("Sheet1")
11  
12  With Cells(1, 1).CurrentRegion
13    Set TrgRang = Intersect(Range("F:J"), .Offset(1, 0))
14  End With
15  TrgRang.Clear
16 
17  With Cells(1, 1).CurrentRegion
18    Set MstRang = Intersect(Range("A:A"), .Offset(1, 0))
19  End With
20
21  Dim C As Range
22  Dim TrgRow As Long   '書込行
23  Dim MstRow As Long   '対象行
24  Dim Tm As Double
25  Dim TmS As Double
26  Dim TmE As Double
27  Dim TmMod As Double
28  Dim TmSyo As Long
29  Dim MstARang As Range
30  TrgRow = 2
31  For Each C In MstRang
32    MstRow = C.Row
33  
34    If Ws.Cells(MstRow, 1).Text <> "" Then
35      TmS = TimeValue(Ws.Cells(MstRow, 4).Text)
36      TmE = TimeValue(Ws.Cells(MstRow, 5).Text)
37      Tm = TmE - TmS
38      TmE = TmS + SpTime
39      
40      TmSyo = (Tm * 1000000) \ (SpTime * 1000000)
41      Set SetRang = Ws.Range("A" & MstRow & ":C" & MstRow)
42      'SpTimeで割った回数
43      For i = 1 To TmSyo
44        Ws.Range("F" & TrgRow & ":H" & TrgRow).Value = SetRang.Value
45        Ws.Range("I" & TrgRow) = Format(TmS, "Short Time")
46        Ws.Range("J" & TrgRow) = Format(TmE, "Short Time")
47        TmS = TmE
48        TmE = TmS + SpTime
49        TrgRow = TrgRow + 1
50      Next
51      'SpTimeで割った余り
52      TmMod = Int((Tm * 1000000) - (TmSyo * SpTime * 1000000)) / 1000000
53      If TmMod > 0 Then
54        Ws.Range("F" & TrgRow & ":H" & TrgRow).Value = SetRang.Value
55        Ws.Range("I" & TrgRow) = Format(TmS, "Short Time")
56        Ws.Range("J" & TrgRow) = Format(TmS + TmMod, "Short Time")
57        TrgRow = TrgRow + 1
58      End If
59    End If
60  Next
61
62End Sub