Добрый день. Есть аппараты, у которых раз в сутки меняются показания Есть программка, которая мониторит эти аппараты, и если показания изменились - фиксирует это Вопрос, как найти время, в которое меняются показания?
Смотрите пример, заранее спасибо!
Добрый день. Есть аппараты, у которых раз в сутки меняются показания Есть программка, которая мониторит эти аппараты, и если показания изменились - фиксирует это Вопрос, как найти время, в которое меняются показания?
первое что видим, это 16:10 - 20:01 Далее 23:00 - 18:44 Поскольку 23:00 не попадает в диапазон 16:10 - 20:01, про него забываем, смотрим второе время. 18:44, оно попадает в диапазон, заменяем 20:01 на 18:44. В итоге получится 16:10 - 18:44
первое что видим, это 16:10 - 20:01 Далее 23:00 - 18:44 Поскольку 23:00 не попадает в диапазон 16:10 - 20:01, про него забываем, смотрим второе время. 18:44, оно попадает в диапазон, заменяем 20:01 на 18:44. В итоге получится 16:10 - 18:44lFJl
Сообщение отредактировал lFJl - Четверг, 08.12.2016, 12:04
K-SerJC, посмотрите пример, в нем формулой написал. Pelena, Верно, но за год много поменялось, хотел макрос сделать лучше, тот не подходит под нынешние требования
K-SerJC, посмотрите пример, в нем формулой написал. Pelena, Верно, но за год много поменялось, хотел макрос сделать лучше, тот не подходит под нынешние требованияlFJl
K-SerJC, Прошу прощения за долгий ответ. Работы много было. Вот под разгребся чуть, занялся делом У меня получилось сделать формулами то, что нужно, пробовал то же самое на макрос перенести, что- то не выходит. Смотрите вложение, надеюсь понятно написал. Надеюсь из примера будет понятно, что мне нужно, и сможете помочь
K-SerJC, Прошу прощения за долгий ответ. Работы много было. Вот под разгребся чуть, занялся делом У меня получилось сделать формулами то, что нужно, пробовал то же самое на макрос перенести, что- то не выходит. Смотрите вложение, надеюсь понятно написал. Надеюсь из примера будет понятно, что мне нужно, и сможете помочь lFJl
Sub ertert() Dim x, y(), i&, sAp, k& x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 3)
For i = 2 To UBound(x) x(i, 1) = x(i, 1) - Int(x(i, 1)) x(i, 2) = x(i, 2) - Int(x(i, 2)) If x(i, 3) <> sAp Then sAp = x(i, 3): k = k + 1 y(k, 1) = sAp y(k, 2) = x(i, 2) 'смена от; y(k, 3) смена до Else If IsEmpty(y(k, 3)) Then y(k, 3) = x(i, 1) If y(k, 3) < y(k, 2) Then y(k, 3) = y(k, 3) + 1 Else If x(i, 1) < y(k, 2) Then x(i, 1) = x(i, 1) + 1 If (x(i, 1) > y(k, 2)) * (x(i, 1) < y(k, 3)) Then y(k, 3) = x(i, 1) End If If (x(i, 2) > y(k, 2)) * (x(i, 2) < y(k, 3)) Then y(k, 2) = x(i, 2) End If Next i Range("P2").Resize(k, 3).Value = y() End Sub
[/vba]
вот так, кажется, получается: [vba]
Код
Sub ertert() Dim x, y(), i&, sAp, k& x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 3)
For i = 2 To UBound(x) x(i, 1) = x(i, 1) - Int(x(i, 1)) x(i, 2) = x(i, 2) - Int(x(i, 2)) If x(i, 3) <> sAp Then sAp = x(i, 3): k = k + 1 y(k, 1) = sAp y(k, 2) = x(i, 2) 'смена от; y(k, 3) смена до Else If IsEmpty(y(k, 3)) Then y(k, 3) = x(i, 1) If y(k, 3) < y(k, 2) Then y(k, 3) = y(k, 3) + 1 Else If x(i, 1) < y(k, 2) Then x(i, 1) = x(i, 1) + 1 If (x(i, 1) > y(k, 2)) * (x(i, 1) < y(k, 3)) Then y(k, 3) = x(i, 1) End If If (x(i, 2) > y(k, 2)) * (x(i, 2) < y(k, 3)) Then y(k, 2) = x(i, 2) End If Next i Range("P2").Resize(k, 3).Value = y() End Sub
nilem, Немного подкорректировал макрос, добавил одну строчку [vba]
Код
If y(k, 3) = "" Then y(k, 3) = x(i, 1)
[/vba] Дело в том, что если лог попадается 1н, то он до не проставляет, благодаря этому - делает!
[vba]
Код
Sub ertert() Dim x, y(), i&, sAp, k& x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 3)
For i = 2 To UBound(x) x(i, 1) = x(i, 1) - Int(x(i, 1)) x(i, 2) = x(i, 2) - Int(x(i, 2)) If x(i, 3) <> sAp Then sAp = x(i, 3): k = k + 1 y(k, 1) = sAp y(k, 2) = x(i, 2) 'смена от; y(k, 3) смена до If y(k, 3) = "" Then y(k, 3) = x(i, 1) Else If IsEmpty(y(k, 3)) Then y(k, 3) = x(i, 1) If y(k, 3) < y(k, 2) Then y(k, 3) = y(k, 3) + 1 Else If x(i, 1) < y(k, 2) Then x(i, 1) = x(i, 1) + 1 If (x(i, 1) > y(k, 2)) * (x(i, 1) < y(k, 3)) Then y(k, 3) = x(i, 1) End If If (x(i, 2) > y(k, 2)) * (x(i, 2) < y(k, 3)) Then y(k, 2) = x(i, 2) End If Next i Range("P2").Resize(k, 3).Value = y() End Sub
[/vba]
Такой вопросик, если у меня время лежит в 1, 3 столбце а название в 14, тогда что нужно в коде поменять для этого?
nilem, Немного подкорректировал макрос, добавил одну строчку [vba]
Код
If y(k, 3) = "" Then y(k, 3) = x(i, 1)
[/vba] Дело в том, что если лог попадается 1н, то он до не проставляет, благодаря этому - делает!
[vba]
Код
Sub ertert() Dim x, y(), i&, sAp, k& x = Range("A1").CurrentRegion.Value ReDim y(1 To UBound(x), 1 To 3)
For i = 2 To UBound(x) x(i, 1) = x(i, 1) - Int(x(i, 1)) x(i, 2) = x(i, 2) - Int(x(i, 2)) If x(i, 3) <> sAp Then sAp = x(i, 3): k = k + 1 y(k, 1) = sAp y(k, 2) = x(i, 2) 'смена от; y(k, 3) смена до If y(k, 3) = "" Then y(k, 3) = x(i, 1) Else If IsEmpty(y(k, 3)) Then y(k, 3) = x(i, 1) If y(k, 3) < y(k, 2) Then y(k, 3) = y(k, 3) + 1 Else If x(i, 1) < y(k, 2) Then x(i, 1) = x(i, 1) + 1 If (x(i, 1) > y(k, 2)) * (x(i, 1) < y(k, 3)) Then y(k, 3) = x(i, 1) End If If (x(i, 2) > y(k, 2)) * (x(i, 2) < y(k, 3)) Then y(k, 2) = x(i, 2) End If Next i Range("P2").Resize(k, 3).Value = y() End Sub
[/vba]
Такой вопросик, если у меня время лежит в 1, 3 столбце а название в 14, тогда что нужно в коде поменять для этого?lFJl
Сообщение отредактировал lFJl - Четверг, 02.02.2017, 11:54