Страницы: 1
RSS
Как загрузить котировки акций из базы финам.ру
 
нужно каждый день выводить график изменений акций (РТС, ммвб) в виде телевизионной рубрикию.  
данные загружаются в DigitalFusion и потом превращаются в видео файл.  
 
также еще с курсами доллара и евро. с ними справился легко методом описанном здесь http://www.planetaexcel.ru/tip.php?aid=32  
 
удалось найти файлик который тянет с финам.ру, но он тянет криво. не сходится с тем что выдает http://www.finam.ru/analysis/export/default.asp  
 
может кто подскажет как поправить запрос в этом файле чтобы он правильно тянул)  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
для выгрузки данных с финама использую следующий метод  
создаю на листе экселя веб запрос к котировкам, макросом обновляю его через нужные мне периоды времени, данные из ячеек в текстовый файл для ведения истории - (этот текстовый файл подвязывается в access, в котором создан запрос на вывод последних n строк текстового файла)- далее в эксель экспортируются данные аксес запроса, строятся графики, расчитываются индикаторы.  
 
Очень интересно посмотреть на ваш файл, если он очень большой - залейте на файлообменик и дайте ссылку.
 
{quote}{login=egonomist}{date=16.11.2011 08:45}{thema=}{post}для выгрузки данных    
 
Очень интересно посмотреть на ваш файл, если он очень большой - залейте на файлообменик и дайте ссылку.{/post}{/quote}  
 
метод такой  
 
Sub GetData()  
'   thanks to Ron McEwan :^)  
 
   Dim QuerySheet As Worksheet  
   Dim DataSheet As Worksheet  
   Dim EndDate As Date  
   Dim StartDate As Date  
   Dim Symbol As String  
   Dim Period As Integer  
   Dim qurl As String  
   Dim nQuery As Name  
     
   Application.ScreenUpdating = False  
   Application.DisplayAlerts = False  
   Application.Calculation = xlCalculationManual  
     
   Set DataSheet = ActiveSheet  
   
       StartDate = DataSheet.Range("C2").Value  
       EndDate = DataSheet.Range("C3").Value  
       Symbol = DataSheet.Range("C1").Value  
       If DataSheet.Range("C4").Value = "H" Then  
       Period = 7  
       ElseIf DataSheet.Range("C4").Value = "D" Then Period = 8  
       Else: Period = 9  
       End If  
       Range("C7").CurrentRegion.ClearContents  
         
         
'construct the URL for the query  
       qurl = "http://export.finam.ru/" & Symbol & "?d=d&m=1&em=16842"  
       qurl = qurl & "&df=" & Day(StartDate) & "&mf=" & Month(StartDate) - 1 & "&yf=" & Year(StartDate) _  
       & "&dt=" & Day(EndDate) - 1 & "&mt=" & Month(EndDate) - 1 & "&yt=" & Year(EndDate) _  
       & "&p=" & Period & "&f=" & Symbol & "&e=.csv&cn=" & Symbol _  
       & "&dtf=1&tmf=1&MSOR=0&sep=1&sep2=1&datf=4&at=1"  
         
       'qurl = "http://chart.yahoo.com/table.csv?s=" & Symbol  
       'qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _  
           "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _  
           Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Range("E3") & "&q=q&y=0&z=" & _  
           Symbol & "&x=.csv"  
       Range("c5") = qurl  
                     
QueryQuote:  
            With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))  
               .BackgroundQuery = True  
               .TablesOnlyFromHTML = False  
               .Refresh BackgroundQuery:=False  
               .SaveData = True  
           End With  
             
           Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _  
               TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _  
               Semicolon:=False, Comma:=True, Space:=False, other:=False  
             
           Range(Range("E7"), Range("E7").End(xlDown)).NumberFormat = "mmm d/yy"  
           Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"  
           Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"  
           Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"  
 
 
   With ThisWorkbook  
       For Each nQuery In Names  
           If IsNumeric(Right(nQuery.Name, 1)) Then  
               nQuery.Delete  
           End If  
       Next nQuery  
   End With  
     
'turn calculation back on  
   Application.Calculation = xlCalculationAutomatic  
   Application.DisplayAlerts = True  
   Range("C7:I2000").Select  
   Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _  
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom  
   Range("B4").Select  
 
End Sub  
 
Ссылка для скачивания файла: http://ifolder.ru/26981392
 
вообще этот метод взят с этого форума, но хоть убей не могу найти снова этот топик, чтобы спросить автора)))
 
{quote}{login=egonomist}{date=16.11.2011 08:45}{thema=}{post}для выгрузки данных с финама использую следующий метод  
создаю на листе экселя веб запрос к котировкам, макросом обновляю его через  
{/post}{/quote}  
 
а можно взглянуть как выглядит синтаксис вашего запроса?
 
В идеале хотелось бы получить строчку запроса как в описанном варианте с импортом из ЦБР  
http://cbr.ru/currency_base/dynamics.aspx?VAL_NM_RQ=["Код валюты"]&date_req1=01.01.1992&r1=1&date_req2=["Дата"]&C_month=01&C_year=1992&rt=1&mode=1&x=58&y=6
как описанно вот тут http://www.planetaexcel.ru/tip.php?aid=32
 
вот тут про запрос на экспорт котировок с финама.  
http://toly-blog.ru/trade/modul-quotes-zagruzhaem-kotirovki/  
проверьте свои параметры, тот ли таймфрейм и по тому ли инструменту грузите.  
 
у себя сделал -как веб-запрос (в 2007 - данные - получить внешние данные - из веба - finam.ru - отметить нужные данные)  
потом вешаем на таймер процедуру  
Public Sub exp()  
'обновляем запрос  
Worksheets("main").QueryTables.Item(1).Refresh BackgroundQuery:=False  
'заполняем массив значениями котировок, его потом можно вывести хоть на лист 'хоть в файл  
For i = 1 To 17 Step 1  
   namecol(i - 1, 0) = Worksheets("main").Range("D" & i + 1 & "")  
 Next i  
dop = "" & Date & ""  
Namef = "kotirovki_" & Replace(dop, ".", "")  
Dim fso, ts  
Set fso = CreateObject("Scripting.FileSystemObject")  
Set f = fso.GetFile("C:\kotirovki\arhive\" & Namef & ".txt")  
Set ts = f.OpenAsTextStream(8, -2)  
'записываем в файл    
For i = 2 To 12 Step 1  
If IsError(Nz(Worksheets("main").Range("E" & i & ""), 0)) = False Then  
sx = Replace(Worksheets("main").Range("E" & i & ""), ".", ",")  
ts.WriteLine "" & CDate(Worksheets("main").Range("I" & i & "")) & ";" &  Worksheets("main").Range("D" & i & "") & ";" & ss & ""  
End If  
Next i  
ts.Close  
 
Call ADOImport  
Call Chert  
wok = Worksheets("main").Range("B8").Value  
If wok = 1 Then  
       Call upquery  
       Call Worksheets("Stock Chart").CBx11_Change  
End If  
End Sub  
 
#53224#
Страницы: 1
Читают тему
Наверх