Excel ETA калькулятор. С изюминкой

Question

Используя Excel, я пытаюсь рассчитать расчетное время прибытия (ETA), рассчитанное на основе поля даты и времени отправления и поля расстояния.Скорость - это сложная часть, потому что она варьируется в зависимости от времени суток.

Пока давайте предположим, что есть только две возможности скорости в зависимости от часа дня.Между 8:00 и 19:00 скорость равна 16. Между 7:00 и 8:00 скорость равна 8. Фактические числа могут сильно отличаться, поэтому не принимайте половину скорости ночью.

Я хочу указать дату и время иформула рассчитывает ETA, используя расстояние и соответствующие скорости на основе времени суток.

Например, поездка на 500 миль, начинающаяся 1 января в 18:00, приведет к 1 часу @ 16, 13 часам @ 8, 11 часам @ 16,13 час @ 8, 6.25 час @ 16.В общей сложности 44,25 часа, прибывающих 3 января в 14:15

Дата плюс 44,25 часа - это глупо просто, но расчет часов на основе времени начала и скорости, возможной в определенные часы, ускользнул от меня.

[ПРАВИТЬ] Вау, вы вложили в это много работы, и я действительно ценю эти усилия.Но он не делает то, что я пытаюсь сделать.

Я пытаюсь взять в качестве входных данных дату и время начала, а также расстояние до пункта назначения.Затем он должен рассчитать ETA, используя переменные скорости в течение дня.Средние не будут делать вообще.Для каждой поездки существует точное ETA, и время в пути на фиксированное расстояние будет значительно различаться в зависимости от времени начала.

Answer 1

Это заняло у меня некоторое время, но я сделал нужную вам функцию. Дата должна быть отформатирована как «2011/01/01 18:00» (убедитесь, что тип ячейки даты, которую вы читаете, и ячейка результата функции имеют тип date). Вы можете легко изменить значение скорости 1 и 2 в коде в соответствии с вашими потребностями.

Function ETA(ByVal myTime As Date, _
             ByVal distance As Double) As Date

Application.ScreenUpdating = False
Dim startTime As Date
Dim minCounter As Double
Dim result As Date
Dim milesTraveled As Double

' add the first hour
myTime = DateAdd("h", 1, myTime)
While distance - milesTraveled >= 16
    If Hour(myTime) >= 8 And Hour(myTime) <= 19 Then
        milesTraveled = milesTraveled + 16
    Else
        milesTraveled = milesTraveled + 8
    End If
    ' increment the time by 1 hour
    myTime = DateAdd("h", 1, myTime)
Wend

' check if any miles left to go (less than 1 hour's worth)
' and calculate minutes based on speed value
If distance - milesTraveled <> 0 Then
    ' ugly error checking to make sure that this isn't the
    ' last hour in the 8 speed period to avoid erroneous
    ' results. You can fix this up to be cleaner.
    If distance - milesTravel >= 8 And Hour(myTime) = 7 Then
        myTime = DateAdd("h", 1, myTime)
        milesTraveled = milesTraveled + 8
        minCounter = ((distance - milesTraveled) / 16) * 60
    Else
        If Hour(myTime) >= 8 And Hour(myTime) <= 19 Then
            minCounter = ((distance - milesTraveled) / 16) * 60
        Else
            minCounter = ((distance - milesTraveled) / 8) * 60
        End If
    End If
End If

' Add left over minutes
result = DateAdd("n", minCounter, myTime)
ETA = result
Application.ScreenUpdating = True

End Function

Я протестировал код и передал его = ETA (cellwithdate, 500) и 2011/01/01 18:00 в качестве значения в cellwithdate, и результат правильно возвращается как 2011/01/03 14: 15.

Как это работает: Я проверяю, чтобы убедиться, что количество пройденных миль составляет целый час (пройденное расстояние - 16 или более). Затем в течение этого часа я проверяю, находится ли он в диапазоне 1 (8:00 и 19:00), если это так, то пройденные мили - это 16, если нет - 8. Затем я добавляю 1 к часу. Когда до поездки осталось менее 1 часа, я вычисляю минуты. Вы можете поработать над этим и сделать код чище, чтобы он был быстрее / добавлена ​​проверка ошибок, но эта функция должна показать вам один способ сделать то, что вы хотите.

Answer 2

Вы можете использовать Пользовательскую функцию и адаптировать следующий код:

Option Explicit

Public Function ETA(dStart As Date, dEnd As Date) As Date
Dim lAvg As Double
Dim iNumDays As Integer, iHours As Integer
Dim lSpeed As Long
Dim dTemp As Date
Dim dFinal As Date

'Get average speed for each full day
lAvg = Application.Average(Range("Speed"))
'Get the number of full days
iNumDays = CInt(dEnd - dStart)
'Add the days
dFinal = iNumDays * lAvg

'Parse every hour from start to midnight
'if end date is midnight, need to correct the loop
If Hour(dEnd) = 0 Then
    iHours = 24
Else
    iHours = Hour(dEnd)
End If
dTemp = dStart
Do While TimeValue(dTemp) <> "00:00:00" And Hour(dTemp) < iHours
    lSpeed = Application.VLookup(Format(dTemp, "hh:mm AM/PM"), Range("TimeSpeed"), 2, False)
    dFinal = DateAdd("h", lSpeed, dFinal)
    'parse another hour
    dTemp = DateAdd("h", 1, dTemp)
Loop

'Do not count the hour twice
'  Check if first date and last date aren't on the same day
'  or start time is midnight
If Day(dStart) <> Day(dEnd) Or TimeValue(dStart) = "00:00:00" Then
    'Parse every hour from midnight to end
    dTemp = dEnd
    Do While TimeValue(dTemp) <> "00:00:00" And Hour(dTemp) > Hour(dStart)
        lSpeed = Application.VLookup(Format(dTemp, "hh:mm AM/PM"), Range("TimeSpeed"), 2, False)
        dFinal = DateAdd("h", lSpeed, dFinal)
        'parse another hour (step backward)
        dTemp = DateAdd("h", -1, dTemp)
    Loop
End If

ETA = dFinal
End Function

вам придется использовать именованные диапазоны :

• TimeSpeed это диапазон: A2:B25
• Speed это диапазон B2:B25

я загрузил образец файла здесь

если у кого-то есть лучшая идея справиться с этой проблемой, милости просим!