Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 173049
08.10.2009, 11:39
25.00 руб.
0 7 2
Компьютеры Программирование
Здравствуйте уважаемые эксперты! Нужно решить следующую задачку на 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, 12:33
общий
это ответ
Здравствуйте, denmmx!
Если значения будут в таком формате как в вашем примере то всё будет работать

Приложение:
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
5
давно
Megaloman
Модератор
137394
1850
08.10.2009, 16:35
общий
это ответ
Здравствуйте, 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
        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

5
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
08.10.2009, 21:07
общий
Megaloman:
Спасибо за макрос, и хочу немного дополнить свой вопрос.
дополнение №1 - данные в ячейках представлены в общем формате. Можно ли дописать макрос так, чтобы он конвертировал данные в ячейках в формат "Дата", а затем выполнял вышеозначенную задачу?
дополнение №2 - расположение столбцов немного изменилось . Даты располагаются в столбцах B и C, начиная со второй строки.
давно
Megaloman
Модератор
137394
1850
08.10.2009, 22:23
общий
denmmx:
Вот решение (модификация решения в ответе), если надо вывести и даты, соответствующие найденным временам.
Код:
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

Вы можете указать любую начальную клетку. Я это изначально предусмотрел.
В макросе First = "A1"
Если верхняя клетка данных в "B2", как Вы спрашиваете во втором дополнении, пишем
First = "B2"
Насчёт первого дополнения пока ответить не готов, надо подумать.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
Megaloman
Модератор
137394
1850
08.10.2009, 22:43
общий
denmmx:
дополнение №1 - данные в ячейках представлены в общем формате. Можно ли дописать макрос так, чтобы он конвертировал данные в ячейках в формат "Дата", а затем выполнял вышеозначенную задачу?
- не получится, дата без года не бывает. Для приведенных данных задача, по моему мнению, невыполнима.
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
Megaloman
Модератор
137394
1850
09.10.2009, 04:36
общий
denmmx:
Вот решение с форматированием ячеек в дату приведенного Вами формата, преобразование строки в дату и поиск значений
мин дата-времени в первом столбце и макс даты-времени во втором. При отсутствии года в дате, похоже, подставляется текущий системный.
Код:
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
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Неизвестный
09.10.2009, 18:42
общий
Megaloman:
Спасибо за ответы, всё работает!
Форма ответа