かきためぬ

書き溜めたいきもちは山々だけど

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分ずつ振り分けたい。

以下のように開始時間と終了時間を書いた表があるとき、
カーソルが合っている時間帯を分割できるようにする。
f:id:hhohh:20150927232914p:plain
図の場合は、カーソルが合っている9:00~10:00の時間帯を分割する。

「時間を分割」ボタンを押したら、分割数を指定する画面を出す。
f:id:hhohh:20150927233521p:plain


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分割してみると、
f:id:hhohh:20150928001513p:plain


9分間の時間帯が4つと、
8分間の時間帯が3つに分割されるようになる。
f:id:hhohh:20150928002121p:plain