Новости:

Подпишитесь на рассылку новых сообщений форума через службу рассылок: Subscribe.ru

Главное меню

Сохранение динамических данных

Автор Виктор Суржиков, 26.12.2018, 17:53

« назад - далее »

Виктор Суржиков

Здравствуйте, вообще то нашел здесь такую же тему
  https://forum.msexcel.ru/index.php?topic=8028.0
  но написана она в 20лохматом году. Поэтому решил создать новую.
В столбцы A-G передаются данные по DDE серверу. Время его работы с 10 до 18:40.
  После 18:40 столбцы удаляются, они мне больше неинтересны.
   Столбцы I-L вспомогательные.
  Во время работы сервера я наблюдаю за динамикой изменения ячейки M2.
Поэтому хотелось бы чтобы данные из ячейки M2 сохранялись например в столбце N
  каждые 2 минуты в новой ячейке. В дальнейшем из этого числового ряда (столбец N) я сделаю
  что нибудь в виде гистограммы для наглядности.
  Понимаю что по хорошему здесь нужен макрос и никто никому ничего не должен.
  Если через макрос не получится то может что то посоветуете формулой.
  Допустим если привязаться к текущему времени компьютера.
Например ЕСЛИ тек время 10:00 то N2=M2
                 ЕСЛИ тек время 10:02 то N3=M2
A вот что писать в ИНАЧЕ я вообще не представляю, чтобы это все корректно работало.
Мне не лень будет вручную эти 200-300 строк заполнить.
  Вообщем как то так.

boa

Здравствуйте,

Растяните свои формулы на нужное растояние и выберите период срабатывания (в секундах) на листе

Dim Prepare As Boolean

Sub NewMacros()
'  Description: включает цикличный запуск для пересчета и фиксации показаний

    With Application
        If .Calculation = xlAutomatic Then Prepare = True: .Calculation = xlManual 'Включает ручной пересчет.
    End With

    With ActiveSheet
        .Calculate                      'пересчитываем лист
        .Cells(.Cells(.Rows.Count, 14).End(xlUp).Row + 1, 14) = .Cells(2, 13).Value 'заносим показания
        Application.OnTime Now + TimeValue("0:0:" & .Range("MyTime").Value), "NewMacros" 'повторяем через время указанное в ячейке MyTime
    End With

End Sub

Sub stopTimer()
'Description: останавливает таймер
    Dim i&
    On Error Resume Next
    With ActiveSheet
        For i = 1 To .Range("MyTime").Value
    Application.OnTime EarliestTime:=Time + TimeValue("0:0:" & i), Procedure:="NewMacros", Schedule:=False
        Next i
    End With
    Application.Calculation = IIf(AutoCalculat, xlAutomatic, xlManual)
End Sub
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктор Суржиков

Здравствуйте, спасибо что помогаете.  При открытии вашего файла появляются 2 окна.
  Мне кажется что то пошло не так.  В чем может быть проблема.
 

boa

Бывает глюк у офиса при открытии файлов из архива или "скачаных из интернета"
Бывает, антивирус чего-то портачит
на всякий случай перезалил

Ну и в конце концов, если файл открылся без модулей, то пересохраните его в формате с поддержкой макросов и вставьте код из предыдущего моего сообщения. Кнопкам присвоите соответствующие макросы.
Ничто не обходится нам так дешево и не ценится так дорого, как вежливость...  Мигель Сервантес де Сааведра

Виктор Суржиков

С этой проблемой справился. Стыдно сказать , просто не были установлены некоторые компоненты офиса. Будем теперь дожидаться рабочего дня и пробовать.