Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Рассчет времени выполнения макроса в статусбаре - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рассчет времени выполнения макроса в статусбаре (Макросы/Sub)
Рассчет времени выполнения макроса в статусбаре
user0 Дата: Понедельник, 31.07.2017, 14:48 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
Доброго времени суток,

Сделал небольшой счетчик рассчета времени выполнения максоса с выводом в статусбар, но возникло несколько проблем:
1) при длительности 5сек и 10,000 циклах - ошибка overflow при расчете времени выполнения (вроде переменные заданы верно и в CLng() пробовал оборачивать)
2) при длительности 5сек и 5,000 циклах - появляется дата в прошлом

Подскажите, пожалуйста, где поправить чтобы оно нормально показывало:
X of X X.X% EndOn HH:MM:SS Remaining: HH:MM:SS of HH:MM:SS

[vba]
Код
Sub StatusBarProgress()
    Dim iTask As Long
    Dim TotalTasks As Long
    Dim secondsPerTask As Integer

    secondsPerTask = Range("B1").Value
    TotalTasks = Range("B2").Value

    For iTask = 1 To TotalTasks
        Application.Wait (Now + TimeValue("00:00:05"))

        Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
        "   EndOn: " & Time() + TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & _
        "   Remaining: " & TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & " of " & TimeSerial(0, 0, TotalTasks * secondsPerTask)
    
    Next iTask
End Sub
[/vba]
К сообщению приложен файл: q1.xlsm (22.4 Kb)


Сообщение отредактировал user0 - Понедельник, 31.07.2017, 14:50
 
Ответить
СообщениеДоброго времени суток,

Сделал небольшой счетчик рассчета времени выполнения максоса с выводом в статусбар, но возникло несколько проблем:
1) при длительности 5сек и 10,000 циклах - ошибка overflow при расчете времени выполнения (вроде переменные заданы верно и в CLng() пробовал оборачивать)
2) при длительности 5сек и 5,000 циклах - появляется дата в прошлом

Подскажите, пожалуйста, где поправить чтобы оно нормально показывало:
X of X X.X% EndOn HH:MM:SS Remaining: HH:MM:SS of HH:MM:SS

[vba]
Код
Sub StatusBarProgress()
    Dim iTask As Long
    Dim TotalTasks As Long
    Dim secondsPerTask As Integer

    secondsPerTask = Range("B1").Value
    TotalTasks = Range("B2").Value

    For iTask = 1 To TotalTasks
        Application.Wait (Now + TimeValue("00:00:05"))

        Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
        "   EndOn: " & Time() + TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & _
        "   Remaining: " & TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & " of " & TimeSerial(0, 0, TotalTasks * secondsPerTask)
    
    Next iTask
End Sub
[/vba]

Автор - user0
Дата добавления - 31.07.2017 в 14:48
SLAVICK Дата: Понедельник, 31.07.2017, 15:13 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
Так?
[vba]
Код
Sub StatusBarProgress()
Dim iTask As Long
Dim TotalTasks As Long
Dim secondsPerTask As Integer
Dim TimeStart As Double

secondsPerTask = Range("B1").Value
TotalTasks = Range("B2").Value
TimeStart = Now

For iTask = 1 To TotalTasks
' Application.Wait (Now + TimeValue("00:00:05"))

' Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
' " EndOn: " & Time() + TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & _
' " Remaining: " & TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & " of " & TimeSerial(0, 0, TotalTasks * secondsPerTask)

Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
" EndOn: " & Format(Now + (TotalTasks - iTask) * secondsPerTask / 86400, "YYYY-MM-DD hh:mm:ss") & _
" Remaining: " & Format(Now - TimeStart, "hh:mm:ss") & " of " & Format(TotalTasks * secondsPerTask / 86400, "hh:mm:ss")

If iTask / 100 = iTask \ 100 Then DoEvents ' это чтоб можно было прервать операцию
Next iTask
End Sub
[/vba]

Добавлено:
Если нужно видеть сколько осталось времени до конца
замените кусок[vba]
Код
Format(Now - TimeStart, "hh:mm:ss")
[/vba] на [vba]
Код
Format((TotalTasks - iTask) * secondsPerTask / 86400, "hh:mm:ss")
[/vba]

Забыл сказать. Ошибку выдает в Вашем коде, потому что функция TimeSerial принимает в качестве аргументов числа типа Integer, a 50 000 - больше допустимых 32767
К сообщению приложен файл: 5447094.xlsm (27.3 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеТак?
[vba]
Код
Sub StatusBarProgress()
Dim iTask As Long
Dim TotalTasks As Long
Dim secondsPerTask As Integer
Dim TimeStart As Double

secondsPerTask = Range("B1").Value
TotalTasks = Range("B2").Value
TimeStart = Now

For iTask = 1 To TotalTasks
' Application.Wait (Now + TimeValue("00:00:05"))

' Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
' " EndOn: " & Time() + TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & _
' " Remaining: " & TimeSerial(0, 0, (TotalTasks - iTask) * secondsPerTask) & " of " & TimeSerial(0, 0, TotalTasks * secondsPerTask)

Application.StatusBar = iTask & " of " & TotalTasks & " " & Format(iTask / TotalTasks, "0.0%") & _
" EndOn: " & Format(Now + (TotalTasks - iTask) * secondsPerTask / 86400, "YYYY-MM-DD hh:mm:ss") & _
" Remaining: " & Format(Now - TimeStart, "hh:mm:ss") & " of " & Format(TotalTasks * secondsPerTask / 86400, "hh:mm:ss")

If iTask / 100 = iTask \ 100 Then DoEvents ' это чтоб можно было прервать операцию
Next iTask
End Sub
[/vba]

Добавлено:
Если нужно видеть сколько осталось времени до конца
замените кусок[vba]
Код
Format(Now - TimeStart, "hh:mm:ss")
[/vba] на [vba]
Код
Format((TotalTasks - iTask) * secondsPerTask / 86400, "hh:mm:ss")
[/vba]

Забыл сказать. Ошибку выдает в Вашем коде, потому что функция TimeSerial принимает в качестве аргументов числа типа Integer, a 50 000 - больше допустимых 32767

Автор - SLAVICK
Дата добавления - 31.07.2017 в 15:13
_Boroda_ Дата: Понедельник, 31.07.2017, 15:16 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
user0, а не переходите ли Вы через сутки (граница 24 часа)? Тогда Time будет маленьким, а Вы из него еще что-то вычитаете

И не забываете статус взад возвращать (если нужно, конечно)
[vba]
Код
Application.StatusBar = False
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеuser0, а не переходите ли Вы через сутки (граница 24 часа)? Тогда Time будет маленьким, а Вы из него еще что-то вычитаете

И не забываете статус взад возвращать (если нужно, конечно)
[vba]
Код
Application.StatusBar = False
[/vba]

Автор - _Boroda_
Дата добавления - 31.07.2017 в 15:16
user0 Дата: Понедельник, 31.07.2017, 16:21 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
SLAVICK
Так?
то что нужно, спасибо большое!
Цитата
функция TimeSerial принимает в качестве аргументов числа типа Integer
вот же.. погуглил все кроме самой фунции %)
а можно немного поподробнее, про вот этот момент:
[vba]
Код
iTask / 100 = iTask \ 100
[/vba] как \ работает?

_Boroda_
а не переходите ли Вы через сутки (граница 24 часа)? Тогда Time будет маленьким, а Вы из него еще что-то вычитаете
переходит через 24, но я вроде только прибавлял к нему положительное число (общее кол-во - выполненое)*сек

Цитата
И не забываете статус взад возвращать (если нужно, конечно)
да, это есть в основном коде )
 
Ответить
СообщениеSLAVICK
Так?
то что нужно, спасибо большое!
Цитата
функция TimeSerial принимает в качестве аргументов числа типа Integer
вот же.. погуглил все кроме самой фунции %)
а можно немного поподробнее, про вот этот момент:
[vba]
Код
iTask / 100 = iTask \ 100
[/vba] как \ работает?

_Boroda_
а не переходите ли Вы через сутки (граница 24 часа)? Тогда Time будет маленьким, а Вы из него еще что-то вычитаете
переходит через 24, но я вроде только прибавлял к нему положительное число (общее кол-во - выполненое)*сек

Цитата
И не забываете статус взад возвращать (если нужно, конечно)
да, это есть в основном коде )

Автор - user0
Дата добавления - 31.07.2017 в 16:21
SLAVICK Дата: Понедельник, 31.07.2017, 16:49 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
это, как по мне, "красивая" замена для
[vba]
Код
if iTask mod 100 = 0
[/vba]
как \ работает?

А Вы попробуйте - и узнаете - лучше самому раз увидеть - на дольше запомнится
Для ленивых ответ под спойлером:


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщениеэто, как по мне, "красивая" замена для
[vba]
Код
if iTask mod 100 = 0
[/vba]
как \ работает?

А Вы попробуйте - и узнаете - лучше самому раз увидеть - на дольше запомнится
Для ленивых ответ под спойлером:

Автор - SLAVICK
Дата добавления - 31.07.2017 в 16:49
user0 Дата: Понедельник, 31.07.2017, 23:57 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
SLAVICK,
Ок, теперь понятно, спасибо огромное )
 
Ответить
СообщениеSLAVICK,
Ок, теперь понятно, спасибо огромное )

Автор - user0
Дата добавления - 31.07.2017 в 23:57
InExSu Дата: Вторник, 01.08.2017, 23:13 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
Тема интересна, сам делаю "самопальные наколенные" индикаторы. Поэтому живо инетересуюсь:
[vba]
Код
of " & Format(TotalTasks * secondsPerTask / 86400, "hh:mm:ss")
[/vba]
выдаёт время в часах, хотя сам макрос работает несколько секунд.
К сообщению приложен файл: 9433666.png (5.3 Kb)


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
СообщениеТема интересна, сам делаю "самопальные наколенные" индикаторы. Поэтому живо инетересуюсь:
[vba]
Код
of " & Format(TotalTasks * secondsPerTask / 86400, "hh:mm:ss")
[/vba]
выдаёт время в часах, хотя сам макрос работает несколько секунд.

Автор - InExSu
Дата добавления - 01.08.2017 в 23:13
SLAVICK Дата: Среда, 02.08.2017, 00:38 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2290
Репутация: 766 ±
Замечаний: 0% ±

2019
выдаёт время в часах

и что? Это же пример.
Если Вы не заметили - я закомментировал
[vba]
Код
Application.Wait (Now + TimeValue("00:00:05"))
[/vba]
если разкомментировать - будет столько работать.
Тут был вопрос про отображение инфы, а не правильный расчет длительности выполнения.
"самопальные наколенные" индикаторы

тогда посмотрите например тут - мне нравится пример Сани в 15-м посте.


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
выдаёт время в часах

и что? Это же пример.
Если Вы не заметили - я закомментировал
[vba]
Код
Application.Wait (Now + TimeValue("00:00:05"))
[/vba]
если разкомментировать - будет столько работать.
Тут был вопрос про отображение инфы, а не правильный расчет длительности выполнения.
"самопальные наколенные" индикаторы

тогда посмотрите например тут - мне нравится пример Сани в 15-м посте.

Автор - SLAVICK
Дата добавления - 02.08.2017 в 00:38
InExSu Дата: Среда, 02.08.2017, 01:02 | Сообщение № 9
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
пример Сани в 15-м пост
.
Поизучаю. На первый взгляд туда нужен "турбонаддув" - если lr > 10000, то быстрее показывать не все r подряд, а более творчески.
К сообщению приложен файл: 4018463.png (3.4 Kb)


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Сообщение отредактировал InExSu - Среда, 02.08.2017, 07:51
 
Ответить
Сообщение
пример Сани в 15-м пост
.
Поизучаю. На первый взгляд туда нужен "турбонаддув" - если lr > 10000, то быстрее показывать не все r подряд, а более творчески.

Автор - InExSu
Дата добавления - 02.08.2017 в 01:02
user0 Дата: Среда, 02.08.2017, 01:21 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 152
Репутация: 8 ±
Замечаний: 0% ±

Excel 2013, 2016
Раскомментировал. Всё равно неправильно считает.
а secondsPerTask и задержка совпадают?)[vba]
Код
Application.Wait (Now + TimeValue("00:00:" & secondsPerTask))
[/vba]


Сообщение отредактировал user0 - Среда, 02.08.2017, 01:22
 
Ответить
Сообщение
Раскомментировал. Всё равно неправильно считает.
а secondsPerTask и задержка совпадают?)[vba]
Код
Application.Wait (Now + TimeValue("00:00:" & secondsPerTask))
[/vba]

Автор - user0
Дата добавления - 02.08.2017 в 01:21
InExSu Дата: Среда, 02.08.2017, 07:59 | Сообщение № 11
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
secondsPerTask и задержка совпадают?

Тогда оно конечно :-)


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
Сообщение
secondsPerTask и задержка совпадают?

Тогда оно конечно :-)

Автор - InExSu
Дата добавления - 02.08.2017 в 07:59
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Рассчет времени выполнения макроса в статусбаре (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!