VBAで時間帯を分割
VBAで時間帯を分割したい。
「8:00~9:00」という1時間分の時間帯があったとき、
以下のように分割数を指定して分けたい。
<2分割>
8:00~8:30(30分間)
8:30~9:00(30分間)
<3分割>
8:00~8:20(20分間)
8:20~8:40(20分間)
8:40~9:00(20分間)
「8:01~9:00(59分間)」を3分割、
というように割り切れない時間帯の場合は、
59 ÷ 3 = 19 余り 2
なので、
8:01~8:21(20分間)
8:21~8:41(20分間)
8:41~9:00(19分間)
というように、余りの2分間を上の時間帯から1分ずつ振り分けたい。
以下のように開始時間と終了時間を書いた表があるとき、
カーソルが合っている時間帯を分割できるようにする。
図の場合は、カーソルが合っている9:00~10:00の時間帯を分割する。
「時間を分割」ボタンを押したら、分割数を指定する画面を出す。
2~10分割から選べるように、
リストボックスのデータを設定する。
Private Sub UserForm_Initialize() With ComboBox1 'リストボックスに項目を追加 .AddItem "2" .AddItem "3" .AddItem "4" .AddItem "5" .AddItem "6" .AddItem "7" .AddItem "8" .AddItem "9" .AddItem "10" 'デフォルト値を"2"に設定 .Text = ComboBox1.List(0) 'リストボックスに直接入力させない .Style = fmStyleDropDownList End With End Sub
AddItemでリストボックスにデータを追加できる。
「キャンセル」ボタンを押したら分割数指定画面を閉じる。
Private Sub CancelButton_Click() 'ユーザーフォームを閉じる Unload Me End Sub
「分割する」ボタンで分割を実行。
Private Sub ExecuteButton_Click() Dim i As Integer Dim index As Integer 'リストボックスで選択した位置 Dim dNum As Integer '分割数 Dim Gyou As Long 'カーソル位置のセルの行番号 Dim sTime As Date '開始時間 Dim eTime As Date '終了時間 Dim dTime As Date '分割時間 Dim oTime As Variant '割り切れない半端な時間 index = UserForm1.ComboBox1.ListIndex 'リストボックスで選択した分割数 dNum = UserForm1.ComboBox1.List(index) 'カーソル位置のセルの行番号 Gyou = ActiveCell.Row '開始時間 sTime = TimeSerial(Range("B" & Gyou), Range("C" & Gyou), "00") '終了時間 eTime = TimeSerial(Range("D" & Gyou), Range("E" & Gyou), "00") '分割時間 dTime = TimeSerial("00", (DateDiff("n", sTime, eTime) \ dNum), "00") '割り切れない半端な時間 oTime = DateDiff("n", sTime, eTime) Mod dNum 'カーソル位置の下にdNum - 1行分、新しい行を挿入 Range("B" & Gyou + 1).Resize(dNum - 1).EntireRow.Insert '終了時間の値をdNum - 1 行下に入れる Range("D" & Gyou + dNum - 1).Value = Range("D" & Gyou).Value Range("E" & Gyou + dNum - 1).Value = Range("E" & Gyou).Value For i = 0 To dNum - 2 sTime = TimeSerial(Range("B" & Gyou + i), Range("C" & Gyou + i), "00") + dTime '終了時間にsTime + dTimeを入れる Range("D" & Gyou + i).Value = Hour(sTime) Range("E" & Gyou + i).Value = Minute(sTime) '割り切れない半端な時間が存在するとき、終了時間に1分足す If oTime > 0 Then Range("E" & Gyou + i).Value = Range("E" & Gyou + i).Value + 1 '終了時間(分)が60のとき値を0にして、終了時間(時)に1を足す If Range("E" & Gyou + i).Value = 60 Then Range("E" & Gyou + i).Value = 0 Range("D" & Gyou + i).Value = Range("D" & Gyou).Value + 1 End If oTime = oTime - 1 End If '開始時間(時) > 終了時間(時)のとき、終了時間(時)に24を足す(24時以降の深夜時間を分割するとき) If Range("B" & Gyou + i).Value > Range("D" & Gyou + i).Value Then Range("D" & Gyou + i).Value = Range("D" & Gyou + i).Value + 24 End If '終了時間の値を1行下の開始時間に入れる Range("B" & Gyou + i + 1).Value = Range("D" & Gyou + i).Value Range("C" & Gyou + i + 1).Value = Range("E" & Gyou + i).Value Next 'ユーザーフォームを閉じる Unload Me End Sub
例えば9:00~10:00の時間帯を7分割してみると、
9分間の時間帯が4つと、
8分間の時間帯が3つに分割されるようになる。