Показать сообщение отдельно
Старый 25.04.2010, 12:38   #1
kvs
Новичок
Джуниор
 
Регистрация: 25.04.2010
Сообщений: 3
По умолчанию построчное сохранение данных в табличном виде

Здравствуйте.
Есть небольшая проблема. Осуществляю передачу данных по DDE из стороннего приложения в Excel 2003. Всего 16 каналов, занимают ячеки с B1 по Q1. С этим проблем нет, данные передаются нормально. Требуется каждую минуту, в этом же листе, сохранять эти данные по типу:со второй строки в столбце A будет выводится дата и время, а в столбцах с B по Q поминутные значения данных поступающих по DDE в ячейки с B1 по Q1. Здесь требуется макрос. С VBA раньше не работал, а сделать надо быстро.
Лист имеет название DDE.

Нашел вот такой пример:
http://forex.kbpauk.ru/showflat.php/...37/an/0/page/1

Создаете лист "DDE", например.
А1 =MT4|BID!EURUSD
Б1 =MT4|ASK!EURUSD
В VB в этом листе создаете процедуру:
Sub Worksheet_Calculate()
WorksheetName = "DDE"
i = Application.WorksheetFunction.Count A(Worksheet
(WorksheetName).Range("A:A"))
j = Application.WorksheetFunction.Count A(Worksheets(WorksheetName).Range(" J:J"))
SpotAsk = Worksheets(WorksheetName).Cells(1, 1).Value
SpotBid = Worksheets(WorksheetName).Cells(1, 2).Value
Worksheets(WorksheetName).Cells(i + 1, 1).Value = Time()
Worksheets(WorksheetName).Cells(i + 1, 3).Value = SpotAsk
Worksheets(WorksheetName).Cells(i + 1, 2).Value = SpotBid
End Sub

Правда здесь по изменению, а требуется сохранение каждую минуту.

Довел до такого вида:

Sub Worksheet_Calculate()
WorksheetName = "DDE"
i = Application.WorksheetFunction.Count A(Worksheets(WorksheetName).Range(" A:A"))
j = Application.WorksheetFunction.Count A(Worksheets(WorksheetName).Range(" R:R"))
DbK1 = Worksheets(WorksheetName).Cells(1, 2).Value
DbK2 = Worksheets(WorksheetName).Cells(1, 3).Value
DbK3 = Worksheets(WorksheetName).Cells(1, 4).Value
DbK4 = Worksheets(WorksheetName).Cells(1, 5).Value
DbK5 = Worksheets(WorksheetName).Cells(1, 6).Value
DbK6 = Worksheets(WorksheetName).Cells(1, 7).Value
DbK7 = Worksheets(WorksheetName).Cells(1, 8).Value
DbK8 = Worksheets(WorksheetName).Cells(1, 9).Value
DbK9 = Worksheets(WorksheetName).Cells(1, 10).Value
DbK10 = Worksheets(WorksheetName).Cells(1, 11).Value
DbK11 = Worksheets(WorksheetName).Cells(1, 12).Value
DbK12 = Worksheets(WorksheetName).Cells(1, 13).Value
DbK13 = Worksheets(WorksheetName).Cells(1, 14).Value
DbK14 = Worksheets(WorksheetName).Cells(1, 15).Value
DbK15 = Worksheets(WorksheetName).Cells(1, 16).Value
DbK16 = Worksheets(WorksheetName).Cells(1, 17).Value
Worksheets(WorksheetName).Cells(i + 1, 1).Value = Time()
Worksheets(WorksheetName).Cells(i + 1, 2).Value = DbK1
Worksheets(WorksheetName).Cells(i + 1, 3).Value = DbK2
Worksheets(WorksheetName).Cells(i + 1, 4).Value = DbK3
Worksheets(WorksheetName).Cells(i + 1, 5).Value = DbK4
Worksheets(WorksheetName).Cells(i + 1, 6).Value = DbK5
Worksheets(WorksheetName).Cells(i + 1, 7).Value = DbK6
Worksheets(WorksheetName).Cells(i + 1, 8).Value = DbK7
Worksheets(WorksheetName).Cells(i + 1, 9).Value = DbK8
Worksheets(WorksheetName).Cells(i + 1, 10).Value = DbK9
Worksheets(WorksheetName).Cells(i + 1, 11).Value = DbK10
Worksheets(WorksheetName).Cells(i + 1, 12).Value = DbK11
Worksheets(WorksheetName).Cells(i + 1, 13).Value = DbK12
Worksheets(WorksheetName).Cells(i + 1, 14).Value = DbK13
Worksheets(WorksheetName).Cells(i + 1, 15).Value = DbK14
Worksheets(WorksheetName).Cells(i + 1, 16).Value = DbK15
Worksheets(WorksheetName).Cells(i + 1, 17).Value = DbK16


End Sub

Пока был макрос под один параметр, еще запись шла под 16 уже не сохраняет и дату еще не выводит.

Заранее спасибо. Буду рад любому ответу.
kvs вне форума Ответить с цитированием