Ссылки на ячейки в Excel Web Power Query

Question

Я пытаюсь создать файл Excel, который будет автоматически извлекать данные с этого сайта (https://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTSTK&symbol=SBIN&date=31JAN2019)

, где я могу изменить символ на основе значения ячейки Excel. Хотя я не могу создатьэто из запроса мощности. Я пытался макрос VBA, но первая попытка работает, но позже он показывает ошибку из-за существующей таблицы. Вот код VBA, который я сделал.

Sub OptionChain()
'
' OptionChain Macro
'
TICKER = Sheets("Sheet1").Cells(1, 1)

Sheets("Sheet2").Select
Cells.Clear
'
ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTSTK&symbol=" & TICKER & "&date=31JAN2019""))," & Chr(13) & "" & Chr(8) & "    Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data0,{{""CALLS OI"", type text}, {""CALLS Chng in OI"", type" & _
    " text}, {""CALLS Volume"", type text}, {""CALLS IV"", type text}, {""CALLS LTP"", type text}, {""CALLS Net Chng"", type text}, {""CALLS Bid Qty"", type text}, {""CALLS Bid Price"", type text}, {""CALLS Ask Price"", type text}, {""CALLS Ask Qty"", type text}, {""Strike Price"", type number}, {""PUTS Bid Qty"", type text}, {""PUTS Bid Price"", type text}, {""PUTS Ask " & _
    "Price"", type text}, {""PUTS Ask Qty"", type text}, {""PUTS Net Chng"", type text}, {""PUTS LTP"", type text}, {""PUTS IV"", type text}, {""PUTS Volume"", type text}, {""PUTS Chng in OI"", type text}, {""PUTS OI"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Changed Type"""


With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [Table 0]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "Table_0"
    .Refresh BackgroundQuery:=False
End With

Может кто-нибудь, пожалуйста, помогитемне, как я могу создать веб-запрос мощности из параметров ячейки.

Спасибо.

Answer 1

Вы можете обратиться к значению ячейки, используя Power Query, определив именованный диапазон.

Таким образом, ваш запрос может выглядеть примерно так:

let
    Symbol = Excel.CurrentWorkbook(){[Name="MySymbol"]}[Content]{0}[Column1],
    Date = Text.Upper(DateTime.ToText(DateTime.LocalNow(),"ddMMMyyyy")),
    Source = Web.Page(Web.Contents("https://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTSTK&symbol=" & Symbol & "&date=" & Date)),
    Data = Source{0}[Data],
    #"Change Type" = Table.TransformColumnTypes(Data, List.Transform(Table.ColumnNames(Data), each {_, type number})),
    #"Replace Errors" = Table.ReplaceErrorValues(#"Change Type", List.Transform(Table.ColumnNames(#"Change Type"), each {_, null}))
in
    #"Replace Errors"

Теперь вы можете изменить символ вячейку "MySymbol" и просто обновите запрос.

Answer 2

Если вы не возражаете против небольшой уборки и отсутствия графиков, вы можете использовать xmlhttp

Option Explicit
Public Sub GetTable()
    Dim sResponse As String, html As HTMLDocument, clipboard As Object, ws As Worksheet, shp As Shape, wsSource As Worksheet
    Set wsSource = ThisWorkbook.Worksheets("symbols")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    ws.Cells.Clear
    ws.Cells.UnMerge

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTSTK&symbol=" & wsSource.Cells(1, 1) & "&date=31JAN2019", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    Set html = New HTMLDocument
    html.body.innerHTML = sResponse

    clipboard.SetText html.querySelectorAll("table").Item(2).outerHTML
    clipboard.PutInClipboard
    ws.Cells(1, 1).PasteSpecial
    ClearCharts ws
End Sub

---

Длинный путь будет:

Option Explicit
Public Sub WriteOutTable()
    Dim sResponse As String, html As HTMLDocument, ws As Worksheet, wsSource As Worksheet, hTable As HTMLTable
    Set wsSource = ThisWorkbook.Worksheets("symbols")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ws.Cells.Clear
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?segmentLink=17&instrument=OPTSTK&symbol=" & wsSource.Cells(1, 1) & "&date=31JAN2019", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    Set html = New HTMLDocument
    html.body.innerHTML = sResponse
    Set hTable = html.querySelector("#octable")

    Dim tr As Object, td As Object, i As Long, th As Object, r As Long, c As Long, lastRow As Long
    lastRow = hTable.getElementsByTagName("tr").Length
    For Each tr In hTable.getElementsByTagName("tr")
        r = r + 1: c = 1
        Select Case r
        Case 1
            ws.Cells(r, 1) = tr.getElementsByTagName("th")(0).innerText
            ws.Cells(r, 12) = tr.getElementsByTagName("th")(2).innerText
        Case 2
            For Each th In tr.getElementsByTagName("th")
                If Not th.title = "Chart" Then
                    c = c + 1
                    ws.Cells(r, c) = th.title
                End If
            Next
        Case lastRow
            ws.Cells(r, 1) = "Total"
            ws.Cells(r, 2) = tr.getElementsByTagName("td")(1).innerText
            ws.Cells(r, 3) = tr.getElementsByTagName("td")(3).innerText
            ws.Cells(r, 19) = tr.getElementsByTagName("td")(5).innerText
            ws.Cells(r, 21) = tr.getElementsByTagName("td")(7).innerText
        Case Else
            c = 2
            For Each td In tr.getElementsByTagName("td")
                If td.classname = "ylwbg" Or td.classname = "nobg" Or td.classname = "grybg" Then
                    ws.Cells(r, c) = td.innerText
                    c = c + 1
                End If
            Next
        End Select
    Next
End Sub