Вопрос в следующем. В одной конкретной ячейке постоянно изменяются данные(числа), допустим раз в минуту. Соответственно необходимо раз в минуту эти данные записывать в таблицу таким образом, чтобы можно было наблюдать зависимость изменения чисел от времени( каждую минуту появляется новое число). другими словами, каждую минуту необходимо из одной ячейки переносить данные в таблицу, данные должны следовать друг за другом, что позволит видеть их зависимость от времени. Каким образом это можно сделать? Предпочтительно получить полную автоматизацию процесса
Вопрос в следующем. В одной конкретной ячейке постоянно изменяются данные(числа), допустим раз в минуту. Соответственно необходимо раз в минуту эти данные записывать в таблицу таким образом, чтобы можно было наблюдать зависимость изменения чисел от времени( каждую минуту появляется новое число). другими словами, каждую минуту необходимо из одной ячейки переносить данные в таблицу, данные должны следовать друг за другом, что позволит видеть их зависимость от времени. Каким образом это можно сделать? Предпочтительно получить полную автоматизацию процессаpandatyt
ИМХО, вопрос по части vba. worksheet_change вам в помощь. вот примерный код если ячейка для ввода A1 и диапазон для накапливания значений и времени B:C
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([B:B]) + 1 If Not Intersect(Target, [A1]) Is Nothing And Not (IsEmpty(Target)) Then Target.Copy [B:C].Cells(n, 1) [B:C].Cells(n, 2) = Now() End If End Sub
[/vba]
ИМХО, вопрос по части vba. worksheet_change вам в помощь. вот примерный код если ячейка для ввода A1 и диапазон для накапливания значений и времени B:C
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([B:B]) + 1 If Not Intersect(Target, [A1]) Is Nothing And Not (IsEmpty(Target)) Then Target.Copy [B:C].Cells(n, 1) [B:C].Cells(n, 2) = Now() End If End Sub
все заработало. но при копировании эксель подвисает на несколько секунд, потом отвисает. в чем может быть проблема? могли бы вы переделать код так, чтобы копирование происходило в том же стиле при совпадении двух ячеек, одна из которых меняется, а вторая нет, при этом вывод даты во второй стобец не происходил? заранее спасибо за великодушную помощь!
все заработало. но при копировании эксель подвисает на несколько секунд, потом отвисает. в чем может быть проблема? могли бы вы переделать код так, чтобы копирование происходило в том же стиле при совпадении двух ячеек, одна из которых меняется, а вторая нет, при этом вывод даты во второй стобец не происходил? заранее спасибо за великодушную помощь!pandatyt
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([C:C]) + 1 If Not Intersect(Target, [A1]) Is Nothing And _ Not (IsEmpty(Target)) And Target = [B1] Then Target.Copy [C:C].Cells(n, 1) End If End Sub
[/vba]
попробуйте перед строкой [vba]
Код
Target.Copy [B:C].Cells(n, 1)
[/vba] добавить строку [vba]
Код
Application.ScreenUpdating = 0
[/vba] если сравнивать с B1 то код вот такой
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim n As Integer n = Application.CountA([C:C]) + 1 If Not Intersect(Target, [A1]) Is Nothing And _ Not (IsEmpty(Target)) And Target = [B1] Then Target.Copy [C:C].Cells(n, 1) End If End Sub
pandatyt, с Вашим файлом и хотелками разбираться, извините, лень, т.к. в таком виде это нужно только Вам. А общий принцип можно применить, например, такой: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False: Application.EnableEvents = False Dim lLastrow&: lLastrow = Me.Cells(Rows.Count, 2).End(xlUp).Row If Not Intersect(Target, [A1]) Is Nothing Then Target.Copy Me.Cells(lLastrow + 1, "B"): Me.Cells(lLastrow + 1, "C") = Now End If Application.ScreenUpdating = True: Application.EnableEvents = True End Sub
[/vba]
pandatyt, с Вашим файлом и хотелками разбираться, извините, лень, т.к. в таком виде это нужно только Вам. А общий принцип можно применить, например, такой: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False: Application.EnableEvents = False Dim lLastrow&: lLastrow = Me.Cells(Rows.Count, 2).End(xlUp).Row If Not Intersect(Target, [A1]) Is Nothing Then Target.Copy Me.Cells(lLastrow + 1, "B"): Me.Cells(lLastrow + 1, "C") = Now End If Application.ScreenUpdating = True: Application.EnableEvents = True End Sub
метод не пробовал еще, приду с работы, испытаю. на самом деле проблема не такая уж и лично моя "хотелочная". есть определенная категория задач, решить которые было бы очень удобно при помощи показанной в файле схемы. тем более ограничения ставятся не мной. в то самое желтое окно идет загрузка данных из другой программы. ексель нужен чтобы анализировать входящие данные. но чтобы их начать анализировать, нужно сначала сохранить. в любом случае спасибо за помощь, добрый человек/люди
метод не пробовал еще, приду с работы, испытаю. на самом деле проблема не такая уж и лично моя "хотелочная". есть определенная категория задач, решить которые было бы очень удобно при помощи показанной в файле схемы. тем более ограничения ставятся не мной. в то самое желтое окно идет загрузка данных из другой программы. ексель нужен чтобы анализировать входящие данные. но чтобы их начать анализировать, нужно сначала сохранить. в любом случае спасибо за помощь, добрый человек/людиpandatyt
если конкретно для примера, то можно попробовать как-нибудь так: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "C6" Then Exit Sub If Target.Count > 1 Then Exit Sub Cells(Minute(Cells(6, 8)) + 5, Hour(Cells(6, 8)) * 3 - 48) = Target End Sub
[/vba] вполне вероятно, что нужно будет использовать не Change событие, а Calculate
Edited: пока писал ответ, оказалось, что уже все решено
если конкретно для примера, то можно попробовать как-нибудь так: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "C6" Then Exit Sub If Target.Count > 1 Then Exit Sub Cells(Minute(Cells(6, 8)) + 5, Hour(Cells(6, 8)) * 3 - 48) = Target End Sub
[/vba] вполне вероятно, что нужно будет использовать не Change событие, а Calculate
Edited: пока писал ответ, оказалось, что уже все решено nilem
Яндекс.Деньги 4100159601573
Сообщение отредактировал nilem - Среда, 21.05.2014, 22:05