ReSQL.ru
     
powered by simpleCommunicator - 2.0.59     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Функция нахождения пересечения временных интервалов
3 сообщений из 3, страница 1 из 1
Функция нахождения пересечения временных интервалов
    #36294401
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
.Михаил.
Участник
В работе часто встречалась необходимость проверки пересечения временных интервалова также - нахождения совокупного временного интервала, во что сделал
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
Public Function PERES(ByVal dti1 As Date, ByVal dti2 As Date, ByVal dtj1 As Date, dtj2 As Date, Optional ByRef dt1 As Date, Optional ByRef dt2 As Date) As Boolean
Dim flag As Boolean
dt1 = dti1: dt2 = dti2: flag = True
If (dtj1 < dti1) And flag Then
    If (dti1 <= dtj2) And (dtj2 <= dti2) And flag Then
        flag = False
        dt1 = dtj1
    End If
    If (dti2 < dtj2) And flag Then
        flag = False
        dt1 = dtj1
        dt2 = dtj2
    End If
End If
If (dti1 <= dtj1) And (dtj1 <= dti2) And flag Then
    If (dti1 <= dtj2) And (dtj2 <= dti2) And flag Then
        flag = False
    End If
    If (dti2 < dtj2) And flag Then
        flag = False
        dt2 = dtj2
    End If
End If
PERES = Not flag
End Function
например
Код: plaintext
1.
2.
3.
4.
5.
6.
Sub ddd()
Dim dt1 As Date, dt2 As Date, dti1 As Date, dti2 As Date, dtj1 As Date, dtj2 As Date
dti1 = DateSerial( 2009 ,  10 ,  1 ): dti2 = DateSerial( 2009 ,  10 ,  31 )
dtj1 = DateSerial( 2009 ,  9 ,  15 ): dtj2 = DateSerial( 2010 ,  2 ,  25 )
If PERES(dti1, dti2, dtj1, dtj2, dt1, dt2) Then MsgBox "Пересекаются, совокупный интервал " & dt1 & " - " & dt2 Else MsgBox "Не пересекаются"
End Sub
может кому пригодиться
...
Рейтинг: 0 / 0
06.11.2009, 12:28
| Ответить | Цитировать | Написать  
Функция нахождения пересечения временных интервалов
    #36294748
Фотография qwrqwr
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
qwrqwr
Участник
.Михаил., эта... я тут вобщем чуть упростил:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Function PERES_2(ByVal beg1 As Date, ByVal beg2 As Date, ByVal end1 As Date, end2 As Date) As Boolean
    If end2 > beg1 And end1 > beg2 Then PERES_2 = True
End Function

Sub ddd_2()
Dim beg1 As Date, beg2 As Date, end1 As Date, end2 As Date
beg1 = DateSerial( 2009 ,  10 ,  1 ): end1 = DateSerial( 2009 ,  10 ,  31 )
beg2 = DateSerial( 2009 ,  9 ,  15 ): end2 = DateSerial( 2010 ,  2 ,  25 )

If PERES_2(beg1, beg2, end1, end2) Then _
MsgBox "Пересекаются, совокупный интервал " & IIf(beg1 < beg2, beg1, beg2) & " - " & IIf(end1 > end2, end1, end2) Else MsgBox "Не пересекаются"
End Sub
...
Рейтинг: 0 / 0
06.11.2009, 14:02
| Ответить | Цитировать | Написать  
Функция нахождения пересечения временных интервалов
    #36295650
.Михаил.
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
.Михаил.
Участник
qwrqwr, Вашу функцию
Код: plaintext
1.
2.
3.
Function PERES_2(ByVal beg1 As Date, ByVal beg2 As Date, ByVal end1 As Date, end2 As Date) As Boolean
    If end2 > beg1 And end1 > beg2 Then PERES_2 = True
End Function
можно тогда еще вот так упростить
Код: plaintext
1.
2.
3.
Function PERES_2(ByVal beg1 As Date, ByVal beg2 As Date, ByVal end1 As Date, end2 As Date) As Boolean
    PERES_2 = ((end2 > beg1) And (end1 > beg2))
End Function
...
Рейтинг: 0 / 0
06.11.2009, 18:12
| Ответить | Цитировать | Написать  
3 сообщений из 3, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Функция нахождения пересечения временных интервалов
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]