Заполнение таблицы по условию

[hamlook]

Здравствуйте. Мне необходимо иногда каждый час переписывать данные из проги по сбору информации в сводную таблицу. Порядком надоедает. В этой проге нет возможности как то копировать все данные или сделать импорт. Оставили одну только возможность копировать только по одому параметру.
Ну вот. Я с помощью скрипта копирую все нужные мне параметры в Эксель.
Помогите сделать макрос для переноса этих данных в соответствующее времени место. Допустим если время 12-00 (или чуть более), то при запуске макроса из листа1 копировались на лист2 на отметку 12 часов.
И еще одна проблемка. В этой проге десятичные разделены точкой, а для расчета мне нужна запятая. Я попробовал создать макрос по замене точки на запятую, но он почемуто только удаляет точки.
Файл примера прилагается.

[doober]

Немного упростил Ваш код

 Public Sub NextTime()

    Application.OnTime Now + TimeSerial(0, 0, 1), "NextTime"
    
    DoEvents
    
  Dim чуть_чуть, hr As Integer
   
чуть_чуть = 10 ' интервал в секундах
   
      If Minute(Now) Mod 60 = 0 And Second(Now) >= 0 And Second(Now) < чуть_чуть Then
  hr = Hour(Now)
   If hr = 0 Then hr = 24
   Sheets("Лист2").Cells(hr + 4, 4) = Replace(Sheets("Лист1").Range("B2").Text, ".", ",")
    Sheets("Лист2").Cells(hr + 4, 5) = Replace(Sheets("Лист1").Range("B3").Text, ".", ",")
   
   
      End If
           
    
End Sub




Private Sub Workbook_Open()
Call NextTime
End Sub

Если таймер не нужен,а запуск вручную,тогда

 Sub Чуть_Чуть()

        
  Dim  hr As Integer

  hr = Hour(Now)
   If hr = 0 Then hr = 24
   Sheets("Лист2").Cells(hr + 4, 4) = Replace(Sheets("Лист1").Range("B2").Text, ".", ",")
    Sheets("Лист2").Cells(hr + 4, 5) = Replace(Sheets("Лист1").Range("B3").Text, ".", ",")
   
        
    
End Sub

[Teslenko_EA]

Здравствуйте hamlook.
Предложение doober прекрасно подходит для решения Вашей задачи, но я позволил себе несколько "причесать" его изменив время таймера (не зачем ежесекундно запускать процедуру) и место размещения кода таймера (в таком виде он может быть размещен в модуле книги)

Public Sub NextTime()
Dim hr%, v1, v2
    DoEvents
    v1 = Replace(Sheets(1).[B2], ".", ",")
    v2 = Replace(Sheets(1).[B3], ".", ",")
    hr = IIf(Hour(Now) = 0, 24, Hour(Now))
    With Sheets(2)
        .Cells(hr + 4, 4) = CDbl(v1)
        .Cells(hr + 4, 5) = CDbl(v2)
    End With
    Application.OnTime Now + TimeSerial(1, 0, 0), "ЭтаКнига.NextTime"
End Sub
Private Sub Workbook_Open()
    NextTime
End Sub

Евгений.

[doober]

Сказано было чуть чуть,я и принял чуть чуть за секунды

[hamlook]

Огромнейшее спасибо! Работает как нужно. Буду пробовать разобратся и настроить под свою задачу.
На Лист1 у меня до 50 значений которые заполняют три таблицы.
Teslenko_EA на твой код можно кнопку настроить? Или на лист переносить надо?
И еще вопросик. Мне некоторые значения при переносе нужно менять + на -, и наоборот. Подскажите как это сделать.

[doober]

Код Евгения работает от момента открытия книги каждый час автоматом,если хотите на кнопку,то вешайте на кнопку

Процедуру Чуть_Чуть()


функция по смене знака

  Function Смена_Знака (Значение As Double, смена As Boolean) As Double

    Select Case смена
 
        Case True
   Смена_Знака= -Значение
        Case False
  Смена_Знака= Значение
    
End Select

End Function

[hamlook]

Спасибо. Пока мне нужна кнопка, потом когда скрипт получится автоматизировать, буду пользоваться кодом Teslenko_EA.

[Teslenko_EA]

Здравствуйте Сергей, автор мог и не заметить, но Вы то знаете, что - "Код Евгения..." на самом деле "Предложение doober" я только "позволил себе несколько причесать его"
Евгений.

[hamlook]

Проблемма с точками-запятыми осталась.
Меняет если число начинается с нуля, а если с другой цифры то удаляет точку, а запятую не ставит.
И те числа которые с нуля - сохраняет как текст, и они в дальнейших вычислениях не учавствуют.

[Teslenko_EA]

Здравствуйте hamlook.
избавит от "Пробдеммы" корректировка кода.
Евгений.
P.S. "Teslenko_EA на твой код..." свои посты я подписываю "Евгений" в надежде, что ко мне будут обращаться по имени.