Sub ttt()
First = "A1" ' Левая верхняя (Первая) клетка с данными
tData1 = Range(First) ' Значение первой клетки
Max2 = TimeSerial(0, 0, 0) ' Максимальное время второго столбца
Min1 = TimeSerial(24, 0, 0) ' Минимальное время первого столбца
i = 0
Do While Trim(tData1) <> ""
tData2 = Range(First).Offset(i, 1)
If MidTime(tData1) < Min1 Then Min1 = MidTime(tData1)
If MidTime(tData2) > Max2 Then Max2 = MidTime(tData2)
i = i + 1
tData1 = Range(First).Offset(i, 0)
Loop
MsgBox (CStr(Min1) + " " + CStr(Max2))
End Sub
Function MidTime(a)
L = Right(Trim(a), 5)
MidTime = TimeSerial(Val(Mid(L, 1, 2)), Val(Mid(L, 4, 2)), 0)
End Function
Sub ttt()
First = "A1" ' Левая верхняя (Первая) клетка с данными
Min1 = TimeSerial(24, 0, 0) ' Минимальное время первого столбца
Max2 = TimeSerial(0, 0, 0) ' Максимальное время второго столбца
i = 0
tData1 = Trim(Range(First)) ' Значение первой клетки
Do While tData1 <> ""
tData2 = Trim(Range(First).Offset(i, 1))
If MidTime(tData1) <= Min1 Then
Min1 = MidTime(tData1)
DMin1 = tData1 ' Дата с минимальным временем в первом столбце
End If
If MidTime(tData2) >= Max2 Then
Max2 = MidTime(tData2)
DMax2 = tData2 ' Дата с максимальным временем во втором столбце
End If
i = i + 1
tData1 = Trim(Range(First).Offset(i, 0))
Loop
If i <> 0 Then
Msg = "Min время 1 столбца " + CStr(Min1) + " в дате " + DMin1 + vbCrLf
Msg = Msg + "Max время 2 столбца " + CStr(Max2) + " в дате " + DMax2
MsgBox (Msg)
Else
MsgBox ("Нет дат")
End If
End Sub
Function MidTime(a)
L = Right(a, 5)
MidTime = TimeSerial(Val(Mid(L, 1, 2)), Val(Mid(L, 4, 2)), 0)
End Function
дополнение №1 - данные в ячейках представлены в общем формате. Можно ли дописать макрос так, чтобы он конвертировал данные в ячейках в формат "Дата", а затем выполнял вышеозначенную задачу?
Sub ppp()
First = "A1" ' Координата левой верхней (первой) клетки с данными
i = 0
tData1 = Trim(Range(First).Offset(0, 0)) ' Значение первой клетки
tData2 = Trim(Range(First).Offset(0, 1))
Do While tData1 <> "" ' Формат ячеек и преобразование строк в даты
' Ищем мин дату в первом столбце и макс дату во втором
t1 = ReForm(First, i, 0, tData1)
t2 = ReForm(First, i, 1, tData2)
If i = 0 Then
DMin1 = t1 ' Значение первой клетки
DMax2 = t2
Else
If DMin1 > t1 Then DMin1 = t1
If DMax2 < t2 Then DMax2 = t2
End If
i = i + 1
tData1 = Trim(Range(First).Offset(i, 0))
tData2 = Trim(Range(First).Offset(i, 1))
Loop
If i <> 0 Then
Msg = "Min дата-время 1 столбца " + CStr(DMin1) + vbCrLf
Msg = Msg + "Max дата-время 2 столбца " + CStr(DMax2)
MsgBox (Msg)
Else
MsgBox ("Нет дат")
End If
End Sub
Function ReForm(rr, ii, jj, tt)
Range(rr).Offset(ii, jj).NumberFormat = "[$-FC19]dd mmmm, hh:mm;@" ' Форматируем ячейку
xx = CDate(Replace(tt, ",", "")) ' Удаляем в строке запятую, преобразуем в дату
Range(rr).Offset(ii, jj) = xx ' Заносим в клетку
ReForm = xx
End Function
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.