時間ごとに金額を計算する

Option Compare Database
Option Explicit
Const BASEDATE_S = "1899-12-30 "
Const BASEDATE_N = "1899-12-31 "
Const BASEDATE_X = "2000-1-1 "

Type typBand
    stt1 As Date
    ent1 As Date
    stt2 As Date
    ent2 As Date
    Tank As Long
End Type

Dim objBand(0 To 3) As typBand

Function initCal()
    objBand(0).stt1 = BASEDATE_S & #6:00:00 AM#
    objBand(0).ent1 = BASEDATE_S & #8:00:00 AM#
    objBand(0).stt2 = BASEDATE_N & #6:00:00 AM#
    objBand(0).ent2 = BASEDATE_N & #8:00:00 AM#
    objBand(0).Tank = 3000
    
    objBand(1).stt1 = BASEDATE_S & #8:00:00 AM#
    objBand(1).ent1 = BASEDATE_S & #6:00:00 PM#
    objBand(1).stt2 = -1
    objBand(1).ent2 = -1
    objBand(1).Tank = 2400

    objBand(2).stt1 = BASEDATE_S & #6:00:00 PM#
    objBand(2).ent1 = BASEDATE_S & #10:00:00 PM#
    objBand(2).stt2 = -1
    objBand(2).ent2 = -1
    objBand(2).Tank = 3000

    objBand(3).stt1 = BASEDATE_S & #10:00:00 PM#
    objBand(3).ent1 = BASEDATE_N & #12:00:00 AM#
    objBand(3).stt2 = BASEDATE_N & #12:00:00 AM#
    objBand(3).ent2 = BASEDATE_N & #6:00:00 AM#
    objBand(3).Tank = 3600

End Function


Function calcKadou()
    
    Call initCal '計算用ワーク初期化
    Dim cn As ADODB.Connection: Set cn = getDbConServer()   'サーバへの接続
    Debug.Print getKin(cn, #4/5/2021#, 1095, 117, CDate("10:00"), CDate("10:29"))

End Function

Function getKin(cn As ADODB.Connection, p訪問日 As Date, p利用者番号 As Long, p担当番号 As Long, p開始時刻 As Date, p終了時刻 As Date)
    
    Dim flg As Boolean
    flg = isKeizoku(cn, p訪問日, p利用者番号, p担当番号, p開始時刻, p終了時刻)
    
    Dim w終了時刻 As Date: w終了時刻 = get終了時刻(flg, p開始時刻, p終了時刻)
    
    Dim i&
    Dim kinKei As Long: kinKei = 0
    For i = 0 To 3
        Dim fun&: fun = getFunBand(p開始時刻, w終了時刻, i)
        Dim kin&: kin = Int(objBand(i).Tank * fun& / 60)
        
        kinKei = kinKei + kin
        'Debug.Print fun, objBand(i).Tank, kin&, kinKei
    Next
    getKin = kinKei

End Function


'継続かの判定
Function isKeizoku(cn As ADODB.Connection, p訪問日 As Date, p利用者番号 As Long, p担当番号 As Long, p開始時刻 As Date, p終了時刻 As Date) As Boolean
    
    Dim w開始時刻 As Date: w開始時刻 = DateAdd("n", -2, p開始時刻) '2分前にする
    Dim w終了時刻 As Date: w終了時刻 = DateAdd("n", 2, p終了時刻) '2分後にする
    
    w開始時刻 = BASEDATE_S & Format$(w開始時刻, "hh:nn:ss")
    
    If w開始時刻 <= w終了時刻 Then
        w終了時刻 = BASEDATE_S & Format$(w終了時刻, "hh:nn:ss")
    Else
        w終了時刻 = BASEDATE_S & Format$(w終了時刻, "hh:nn:ss")
    End If
    
    Const sql$ = "select 1 from [HelpData01].[dbo].[T_訪問] AS HOU" & _
        " left join [HelpData01].[dbo].[T_担当] AS TAN" & _
        " ON TAN.[訪問日]=HOU.[訪問日] AND HOU.[SEQ]=TAN.[SEQ]" & _
        " where HOU.区分<>2500" & _
        " and HOU.訪問日=? and HOU.利用者番号=? " & _
        " and TAN.[担当者コード]=?" & _
        " and ( (TAN.[実開始時刻] <= ? and TAN.[実終了時刻]>=?) or (TAN.[実開始時刻] <= ? and TAN.[実終了時刻]>=?) )"
    
    Dim rsServer As ADODB.Recordset
    
    Set rsServer = GetServerRs(cn, False, sql$, p訪問日, p利用者, p担当番号, w開始時刻, w開始時刻, w終了時刻, w終了時刻)
    If rsServer.EOF Then
        isKeizoku = False
    Else
        isKeizoku = True
    End If
    rsServer.Close

End Function

Function get終了時刻(isKeizoku As Boolean, p開始時刻 As Date, p終了時刻 As Date) As Date

    Dim w開始時刻 As Date: w開始時刻 = BASEDATE_S & Format$(p開始時刻, "hh:nn:ss")
    Dim w終了時刻 As Date
    If p開始時刻 <= p終了時刻 Then
        w終了時刻 = BASEDATE_S & Format$(p終了時刻, "hh:nn:ss")
    Else
        w終了時刻 = BASEDATE_N & Format$(p終了時刻, "hh:nn:ss")
    End If
    
    '稼働時間を計算する
    Dim 稼働時間 As Long
    稼働時間 = DateDiff("n", w開始時刻, w終了時刻)
   
    If Not isKeizoku And 稼働時間 < 60 Then '継続でない場合
        get終了時刻 = DateAdd("n", 60, w開始時刻)
    Else
        Dim 商 As Integer
        Dim 余り As Integer
        商 = Int(稼働時間 / 30)
        余り = 稼働時間 Mod 30
        If 余り >= 10 Then
            商 = 商 + 1
        End If
        
        get終了時刻 = DateAdd("n", 商 * 30, w開始時刻)
    End If
    
End Function

Function getFunBand(p開始時刻 As Date, p終了時刻 As Date, ixBand As Long) As Integer
    Dim A As Integer
    Dim B As Integer
    Dim start_time_1 As Date
    Dim end_time_1 As Date
    Dim start_time_2 As Date
    Dim end_time_2 As Date
    
    start_time_1 = objBand(ixBand).stt1
    end_time_1 = objBand(ixBand).ent1
    start_time_2 = objBand(ixBand).stt2
    end_time_2 = objBand(ixBand).ent2
    
    
    Dim w開始時刻 As Date: w開始時刻 = BASEDATE_S & Format$(p開始時刻, "hh:nn:ss")
    Dim w終了時刻 As Date
    If p開始時刻 <= p終了時刻 Then
        w終了時刻 = BASEDATE_S & Format$(p終了時刻, "hh:nn:ss")
    Else
        w終了時刻 = BASEDATE_N & Format$(p終了時刻, "hh:nn:ss")
    End If
    
    If w開始時刻 <= end_time_1 And w終了時刻 >= start_time_1 Then
        A = DateDiff("n", IIf(w開始時刻 < start_time_1, start_time_1, w開始時刻), IIf(w終了時刻 > end_time_1, end_time_1, w終了時刻))
    End If
    
    If w開始時刻 <= end_time_2 And w終了時刻 >= start_time_2 Then
        B = DateDiff("n", IIf(w開始時刻 < start_time_2, start_time_2, w開始時刻), IIf(w終了時刻 > end_time_2, end_time_2, w終了時刻))
    End If
    
    'Debug.Print A, B, A + B, objBand(ixBand).Tank
    getFunBand = A + B
End Function