Format даты

Автор RAN, 13 ноября 2014, 19:07

0 Пользователи и 1 гость просматривают эту тему.

RAN

Всем мяу.
Решил поэкспериментировать с
http://forumooo.ru/index.php/topic,4600.0.html
Поскольку ПРАВИЛЬНОписание хромает, написал код на VBA.
В Excel время работы 0,1сек.
Запустил код в Либре. Сначала решил, что макрос вообще работать не хочет, после оказалось что работает, но время выполнения 60 секунд.
Методом научного тыка выяснил, что проблема в формате даты
           If Format(arr(i, 1), "hh") = 16 Then
           arrTmp(k, 1) = Format(arr(i, 1), "dd.mm.yyyy")

Т.е. если убрать из кода форматирование даты, работает шустренько (время правда не засекал)
Покурил Питоньяка, но ничего путного ну выкурил.
Вопрос - в ОО вообще нельзя произвольно форматировать дату, или я не нашел?
Обрабатываемый массив arr создается как Variant.

JohnSUN

Ну, во-первых, не 16, а 15 - см. поправку (прозевал, наверное?)
Во-вторых, чистый Format в StarBasic'е всегда работал шустро. Возможно, тормоза связаны с эмуляцией VBA. Я же так понял, что ты не шутил насчет "написал код на VBA"?
В третьих, Variant-то он, конечно, Variant, но какого типа конкретный arr(i, 1)? Там не получится, что ты строку неявно приводимую к дате через Format перегоняешь в строку?
И в-четвёртых, чего жадничаешь? Показал бы уже всё, что успел наваять! Интересно же...
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

Полный код (закомментирован вариант со словарем, оставлен на массивах)
Sub Мяв()
   Dim lr&, i&, k&, t!
   Dim arr, aItem, aKey, arrTmp()
'    Dim oDic As Object
t = Timer '
'Set oDic = CreateObject("Scripting.Dictionary")
k = 1
   With Sheets(1)
'        Set oDic = CreateObject("Scripting.Dictionary")
       lr = .Columns(1).Find("*", , , , 2, 2).Row
       arr = .Range(.Cells(1, 1), .Cells(lr, 2)).Value
       ReDim arrTmp(1 To UBound(arr), 1 To 2)
       For i = UBound(arr) To 1 Step -1
           If Format(arr(i, 1), "hh") = 16 Then
           arrTmp(k, 1) = Format(arr(i, 1), "dd.mm.yyyy")
           arrTmp(i, 2) = arr(i, 2)
           k = k + 1
           
'                oDic.Item(Format(arr(i, 1), "dd.mm.yyyy")) = arr(i, 2)
           ElseIf Format(arr(i, 1), "hh") = 12 Then
           arrTmp(k, 1) = Format(arr(i, 1), "dd.mm.yyyy")
           arrTmp(i, 2) = arr(i, 2)
           k = k + 1
'                oDic.Item(Format(arr(i, 1), "dd.mm.yyyy")) = arr(i, 2)
           End If
       Next
'        aItem = oDic.items
'        aKey = oDic.Keys
       ReDim arr(1 To k, 1 To 2)
'        ReDim arr(1 To oDic.Count, 1 To 2)
       For i = 1 To UBound(arr) - 1
       arr(i, 1) = arrTmp(i, 1) & " - " & arrTmp(i + 1, 1)
       arr(i, 2) = (Val(arrTmp(i, 1)) + Val(arrTmp(i + 1, 1))) / 2
'            arr(i, 1) = aKey(i - 1) & " - " & aKey(i)
'            arr(i, 2) = (Val(aItem(i - 1)) + Val(aItem(i - 1))) / 2
       Next
       .Cells(1, 6).Resize(UBound(arr), 2) = arr
       .Columns(6).AutoFit
   End With
   Debug.Print Format(Timer - t, "0.00000")
End Sub

JohnSUN

Н-да... В общем, смотри "во-первых" (условие в IF'е поправь) и "в-третьих" (проверь типы значений в таблице).
И по ходу дела ещё обрати внимание:  ...+ Val(arrTmp(i + 1, 1))) / 2 штука в общем-то правильная. Но, к сожалению, никто не гарантировал уникальность данных. То есть, если скрипт нарвётся на восемь замеров температуры за 24.01.2012 12:00, то он восемь раз эти половинки к результату и присобачит прикотячит...
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

#4
"Во первых" не проблема, но твоя ссылка на другую тему, которую я вообще не видел.
"Во вторых" или "В четвертых" - словарь этого не позволит.
Осталось "в третьих" - в чем проблема с Format?

Поскольку я не понял, что в итоге нужно, сочинил "нечто".
Это "нечто" легко правится под задачу, но только в "долгоиграющем" варианте.
Как сделать быстро, не знаю...

JohnSUN

А чего ты от него пытаешься добиться ожидаешь? Почему не оставить дату датой?
Опять же, если он даже и тормозит, то зачем ты его упорно вызываешь в каждой итерации по четыре раза? Вычисли один раз да и закинь во временную  переменную, всё ж быстрее будет...
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

#6
Цитата: JohnSUN от 13 ноября 2014, 18:18Почему не оставить дату датой?
Во первых, потому, что Date <> Now (которое присутствует в файле)
Now = Date + Time
Во вторых, из даты нужно вытащить время для сравнения
В третьих, из даты нужно удалить время.
В четвертых - это все можно решить другим алгоритмом, правда значительно более сложным)
И, наконец, вернемся к нашим баранам - почему?

PS
Цитата: JohnSUN от 13 ноября 2014, 18:18Вычисли один раз да и закинь во временную  переменную
???????????
Что вычислить один раз? И зачем?

RAN

Этот макрос отрабатывает в Либре за 2 сек
Sub Мяу_Мяв()
    Dim lr&, i&, t!
    Dim arr, aItem, aKey
    Dim oDic As Object
    t = Timer
    Set oDic = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        Set oDic = CreateObject("Scripting.Dictionary")
        lr = .Columns(1).Find("*", , , , 2, 2).Row
        arr = .Range(.Cells(1, 1), .Cells(lr, 2)).Value
        For i = UBound(arr) To 1 Step -1
            If Mid(arr(i, 1), 12, 2) = "16" Then
                oDic.Item(Left(arr(i, 1), 10)) = arr(i, 2)
            ElseIf Mid(arr(i, 1), 12, 2) = "12" Then
                oDic.Item(Left(arr(i, 1), 10)) = arr(i, 2)
            End If
        Next
        aItem = oDic.items
        aKey = oDic.Keys
        ReDim arr(1 To oDic.Count, 1 To 2)
        For i = 1 To UBound(arr) - 1
            arr(i, 1) = aKey(i - 1) & " - " & aKey(i)
            arr(i, 2) = (Val(aItem(i - 1)) + Val(aItem(i - 1))) / 2
        Next
        .Cells(1, 6).Resize(UBound(arr), 2) = arr
        .Columns(6).AutoFit
    End With
        Msgbox Format(Timer - t, "0.00000")
End Sub

Уже лучше, но до 0,1 далеко.

JohnSUN

Данные ты берёшь из temperature.ods, который в этой теме? Ничего не менял предварительно, не сортировал и т.п.? И хочешь выбросить на этот же лист с колонки F какое-то "нечто", которое обязано сформироваться за 0,1 секунду?
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

Мои эксперименты

JohnSUN

Ну, толково... Но, как всегда, "последняя ошибка в программе всегда только предпоследняя"... Глянь на 26-ую строку
arr(i, 2) = (Val(aItem(i - 1)) + Val(aItem(i - 1))) / 2Тебя в ней ничего не тревожит?
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

#11
Меня нет. А тебя?
Так, на всякий який - lbound(arr) =1, ldound(aItem) = 0

PS Хотя вспомнил. В Либре там есть какая то проблема. Но она на данном этапе меня не шибко интересует. Я не пишу "код под ключ". Я изучаю возможности и варианты.
Словарь есть, массивы есть, можно и на коллекции сделать.

JohnSUN

Цитата: RAN от 13 ноября 2014, 21:37
Меня нет. А тебя?
Не тревожило б - не переспросил. Ты складываешь одно и то же значение, удваиваешь его. Потом получившуюся сумму рубишь пополам... Чтобы вернуться к исходному значению...
Ну, дело твоё - каждый развлекается как умеет  :beer:
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

RAN

Ну да, сдаюсь.
Но, как я уже писал, все эти нюансы меня не щекотают.
Меня интересует работа Format.
Есть альтернатива?
Или нужны костыли?
Или костыли есть в стандартных библиотеках ОО?

JohnSUN

Да нормально он работает! Я же специально во втором цикле, где окончательная обработка идёт, этот Format воткнул...
Мой вариант тоже глюкавый, не учитывает возможных дырок в измерениях. Например, 01.02.2012 не было замера в 15:00, а макрос на это плюёт
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне