| Вопрос: Массив запарил :( Help | Добавлено: 29.10.05 16:32 |
Автор вопроса:  XPress | ICQ: 249007960 |
|
Имеется промежуток времени [time1, time2], двумерный массив tarif(4,2), который определяет тарификацию времени! А именно: элементы с индексом (х, 1) это начало действия тарифа(х:хх), элементы с индексом (х, 2) - стоимость одного часа, например:
tarif(1, 1) = 8:00; tarif(1, 2) = 2.00 tarif(2, 1) = 12:00; tarif(2, 2) = 3.00 tarif(3, 1) = 16:00; tarif(3, 2) = 4.50 tarif(4, 1) = 20:00; tarif(4, 2) = 4.00 Нужно написать такую функцию: private function raschet(time1 as string, time2 as string) as single
end sub которая высчитывает согласно указанным тарифам, на пример если человек просидел за компом с 10:45 до 12:16 считается сначала, с 10:45 до 12:00 по tarif(1, 2), так как 8:00<10:45<12:00 , а дальше по tarif(2, 2), так как 12:00<12:16<16:00. В итоге raschet("10:45", "12:16")=3.30. Нужен оптимальный алгоритм решения этой задачи, всем заранее спасибо! |
| Ответы | Всего ответов: 3 |
|
Номер ответа: 1 Автор ответа:  GSerg Вопросов: 0 Ответов: 1876 
|
Профиль | | #1 | Добавлено: 29.10.05 17:34 |
| А если человек просидел сутки с 10:00 до 10:01? | ||
|
Номер ответа: 2 Автор ответа: XPress ICQ: 249007960 Вопросов: 3 Ответов: 8 |
Профиль | | #2 | Добавлено: 29.10.05 17:44 |
| Это можно учесть не в этом кусочке кода! То есть в любом другом месте самой проги! Но если есть какие либо воображения на счет этого, был бы рад если ты поделился ими со мной! | ||
|
Номер ответа: 3 Автор ответа: GSergВопросов: 0 Ответов: 1876
|
Профиль | | #3 | Добавлено: 29.10.05 19:47 |
|
Не знаю, чё получилось, особо не тестил, но вроде работает...
Переход через полночь, а также целые сутки учитываются. Option Explicit
Private Type Tariff From As Date Amount As Currency End Type Private Sub Form_Load() Dim arr(1 To 4) As Tariff 'Подразумевается, что массив тарифов отсортирован по возрастанию времени. With arr(1) .From = TimeSerial(8, 0, 0) .Amount = 2 End With With arr(2) .From = TimeSerial(12, 0, 0) .Amount = 3 End With With arr(3) .From = TimeSerial(16, 0, 0) .Amount = 4.5 End With With arr(4) .From = TimeSerial(20, 0, 0) .Amount = 4 End With MsgBox GetAmount(arr, "29.10.2005 10:45:00", "30.10.2005 10:44:00" 
End Sub Private Function NextElem(arr() As Tariff, ByVal index As Long) As Long NextElem = index + 1 If NextElem > UBound(arr) Then NextElem = LBound(arr) End Function Private Function PrevElem(arr() As Tariff, ByVal index As Long) As Long PrevElem = index - 1 If PrevElem < LBound(arr) Then PrevElem = UBound(arr) End Function Private Function MAX(ByVal v1 As Date, ByVal v2 As Date) As Date If v1 > v2 Then MAX = v1 Else MAX = v2 End Function Private Function MIN(ByVal v1 As Date, ByVal v2 As Date) As Date If v1 > v2 Then MIN = v2 Else MIN = v1 End Function Private Function Get24Worth(Tariffs() As Tariff) As Currency Dim i As Long, t As Date For i = LBound(Tariffs) To UBound(Tariffs) t = Abs((Tariffs(NextElem(Tariffs, i)).From - Tariffs(i).From)) Get24Worth = Get24Worth + Tariffs(i).Amount * (Hour(t) + Minute(t) / 60 + Second(t) / 3600) Next End Function Private Function GetAmount(Tariffs() As Tariff, ByVal DateFrom As Date, ByVal DateTo As Date) As Currency Dim i As Long, diff As Long, e1 As Long, e2 As Long Dim t As Date, Worth24 As Currency If DateTo < DateFrom Then Err.Raise 5 diff = Fix(DateTo - DateFrom) If diff >= 1 Then Worth24 = Get24Worth(Tariffs) GetAmount = Worth24 * diff  ateTo = DateTo - diff
End If If DateTo = DateFrom Then Exit Function ateFrom = DateFrom - Fix(DateFrom)
ateTo = DateTo - Fix(DateTo)
e1 = UBound(Tariffs) + 1 e2 = e1 For i = LBound(Tariffs) To UBound(Tariffs) If Tariffs(i).From >= DateFrom Then If e1 > PrevElem(Tariffs, i) Then e1 = PrevElem(Tariffs, i) End If If Tariffs(i).From >= DateTo Then If e2 > PrevElem(Tariffs, i) Then e2 = PrevElem(Tariffs, i) End If Next If e1 = e2 Then If DateTo > DateFrom Then t = DateTo - DateFrom GetAmount = GetAmount + Tariffs(e1).Amount * (Hour(t) + Minute(t) / 60 + Second(i) / 3600) Else If Worth24 = 0 Then Worth24 = Get24Worth(Tariffs) t = Abs(Tariffs(NextElem(Tariffs, e2)).From - DateTo) GetAmount = GetAmount + Worth24 - GetAmount(Tariffs, DateTo, DateFrom) End If ElseIf e2 > e1 Then For i = e1 To e2 t = MAX(DateFrom, Tariffs(i).From) - MIN(DateTo, Tariffs(NextElem(Tariffs, i)).From) GetAmount = GetAmount + Tariffs(i).Amount * (Hour(t) + Minute(t) / 60 + Second(i) / 3600) Next Else For i = e1 To UBound(Tariffs) t = Abs(MAX(DateFrom, Tariffs(i).From) - Tariffs(NextElem(Tariffs, i)).From) GetAmount = GetAmount + Tariffs(i).Amount * (Hour(t) + Minute(t) / 60 + Second(i) / 3600) Next For i = LBound(Tariffs) To e2 t = Abs(Tariffs(i).From - MIN(DateTo, Tariffs(NextElem(Tariffs, i)).From)) GetAmount = GetAmount + Tariffs(i).Amount * (Hour(t) + Minute(t) / 60 + Second(i) / 3600) Next End If End Function |
||
Страница: 1 |