Хостинг портала RFpro.ru:
Московский хостер
Профессиональный платный хостинг на базе Windows 2008

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Чемпионы рейтинга экспертов в этой рассылке

Гуревич Александр Львович Статус: 10-й класс Рейтинг: 992 ∙ повысить рейтинг »

Megaloman Статус: Бакалавр Рейтинг: 626 ∙ повысить рейтинг »

Botsman Статус: Специалист Рейтинг: 514 ∙ повысить рейтинг »

Вопрос № 173049: Здравствуйте уважаемые эксперты! Нужно решить следующую задачку на VBA (навписать макрос). В таблице Microsoft Excel есть два столбца, каждый из которых содержит ячейки в формате "Дата". Т.е. выглядит это примерно так: -----------...

Здравствуйте уважаемые эксперты! Нужно решить следующую задачку на VBA (навписать макрос).
В таблице Microsoft Excel есть два столбца, каждый из которых содержит ячейки в формате "Дата". Т.е. выглядит это примерно так:

--------------------------------------------------
A | B
--------------------------------------------------
27 августа, 11:07 | 27 августа, 11:20
27 августа, 10:52 | 27 августа, 11:05
27 августа, 11:07 | 27 августа, 12:15
27 августа, 11:04 | 27 августа, 12:35
--------------------------------------------------

Что нужно сделать: из первого столбца выбрать значение даты и минимальное время, из второго - значение даты и максимальное время, и присвоить эти значения двум переменным, например a и b. Спасибо!

Отправлен: 08.10.2009, 11:39
Вопрос задал: denmmx, Посетитель
Всего ответов: 2
Страница вопроса »

Приложение:
Sub aa() Dim wrmin, wrmax, tmmin, tmmax, datmin, datmax As Date i = 1 j = 1 posmin = InStr(1, Cells(i, j).Value, ",") tmmin = Mid(Cells(i, j).Value, posmin + 1, Len(Cells(i, j).Value) - (posmin)) wrmin = tmmin posmax = InStr(1, Cells(i, j + 1).Value, ",") tmmax = Mid(Cells(i, j + 1).Value, posmax + 1, Len(Cells(i, j + 1).Value) - (posmax)) wrmax = tmmax i = 2 Do If Cells(i, j).Value = "" Then Exit Do Else posmin = InStr(1, Cells(i, j).Value, ",") tmmin = Mid(Cells(i, j).Value, posmin + 1, Len(Cells(i, j).Value) - (posmin)) If tmmin < wrmin Then wrmin = tmmin datmin = Mid(Cells(i, j).Value, 1, posmin - 1) End If posmax = InStr(1, Cells(i, j + 1).Value, ",") tmmax = Mid(Cells(i, j + 1).Value, posmax + 1, Len(Cells(i, j + 1).Value) - (posmax)) If tmmax > wrmax Then wrmax = tmmax datmax = Mid(Cells(i, j).Value, 1, posmax - 1) End If End If i = i + 1 Loop MsgBox "Минимальное время в первом столбце " & datmin & " " & wrmin & " максимальное время во втором столбце " & datmax & " " & wrmax & " " End Sub

Ответ отправил: NRJ, 3-й класс
Ответ отправлен: 08.10.2009, 12:33

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255158 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Отвечает Megaloman, Бакалавр :
Здравствуйте, denmmx. Вот решение, которое выдаст в ответе время, а не строку. По виду, как я считаю, оно более читаемое

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
        tDat
 a1 = 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

Ответ отправил: Megaloman, Бакалавр
Ответ отправлен: 08.10.2009, 16:35

Оценка ответа: 5

Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 255165 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (25 руб.) Хорошо (35 руб.) Отлично (50 руб.) БЛЕСТЯЩЕ! (75 руб.)

Вам помогли? Пожалуйста, поблагодарите эксперта за это!

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »