Question

我在Excel2016中使用PowerQuery创建了与REST API的连接，它为我提供了有关公司的信息。

在某个查询表中，加载结果后，将出现一个列有公司ID的列。现在，我希望能够单击某些ID，并且可以将此ID作为标头中的参数传递给我的新查询。我的连接字符串如下所示：

let
    Source = Json.Document(Web.Contents("https://rejestr.io/api/v1/persons/"& Excel.CurrentWorkbook(){[Name="ID"]}[Content]{0}[Column1] &"/relations", [Headers=[Authorization="xxxxxxxxx"]]))
<..rest of the code, mainly formatting...>
in
"ColumnChanged"

这里是从某个单元格（用户提供）中引用ID，但我希望能够在此位置传递ID列中仅所选单元格中的值，然后应创建一个新查询并将其加载到新查询中工作表。

我正在考虑使用此功能从该列中“获取”值单元格：

Worksheet_SelectionChange（ByVal目标作为范围）

但是我不知道如何使用该命令启动新的电源查询...

亚历克斯

Answer 1

通常，这种想法是避免直接通过VBA操作Power Query代码（因为您不能确定结果在M上的语法上是否有效）。

但是，您似乎确实希望创建一个单独的新工作表并在用户每次单击ID时进行查询。

因此，我建议您忽略我以前的答案/方法，然后尝试下面的代码。我无法测试代码（因为我没有此rejestr.io API的凭据），但我认为它应该可以工作：

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.CountLarge <> 1 Then Exit Sub
    If Intersect(Target.Parent.Range("ID"), Target) Is Nothing Then Exit Sub

    ' If there is any additional validation required (e.g. if the ID should be numeric,
    ' or should satisfy some condition/criteria) then it should be done here
    ' before proceeding to code below.

    Dim idSelected As String
    idSelected = Target.Value

    Dim targetQuery As WorkbookQuery
    Set targetQuery = GetOrCreateQueryFromId(idSelected)

    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Worksheets.Add

    Dim targetTable As ListObject
    Set targetTable = targetSheet.ListObjects.Add( _
        SourceType:=0, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & targetQuery.Name & ";Extended Properties=""""", _
        Destination:=targetSheet.Range("$A$1") _
    )

    With targetTable.QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & targetQuery.Name & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_" & targetQuery.Name
        .Refresh BackgroundQuery:=False
    End With
End Sub


Private Function GetOrCreateQueryFromId(ByVal someId As String) As WorkbookQuery
    ' Should accept an ID and return the existing WorkbookQuery object.
    ' If no query for the ID exists, this function should create one (and then
    ' return the newly created query).

    Dim targetQuery As WorkbookQuery

    On Error Resume Next
    Set targetQuery = ThisWorkbook.Queries(someId)
    On Error GoTo 0

    Dim queryAlreadyExists As Boolean
    queryAlreadyExists = Not (targetQuery Is Nothing)

    Dim queryFormula As String
    queryFormula = CreateQueryFormulaFromId(someId)

    If queryAlreadyExists Then
        targetQuery.Formula = queryFormula
        Set GetOrCreateQueryFromId = targetQuery
        Exit Function
    End If

    Set GetOrCreateQueryFromId = ThisWorkbook.Queries.Add(Name:=someId, Formula:=queryFormula)
End Function


Private Function CreateQueryFormulaFromId(ByVal someId As String) As String
    ' Given an ID, should return the Power Query code (code only) required to get data for that ID.
    ' This function returns the code itself only. It doesn't create the query object.

    CreateQueryFormulaFromId = _
        "let" & Chr(13) & "" & Chr(10) & _
        " Source = Json.Document(Web.Contents(""https://rejestr.io/api/v1/krs/" & someId & "/relations"", [Headers=[Authorization=""x""]]))," & Chr(13) & "" & Chr(10) & _
        " #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error), " & Chr(13) & "" & Chr(10) & _
        " #""Expanded Column1"" = Table.ExpandRecordColumn(#""Converted to Table"", ""Column1"", {""address"", ""business_insert_date"", ""ceo"", ""current_relations_count"", ""data_fetched_at"", ""first_entry_date"", ""historical_relations_count"", ""id"", ""is_opp"", ""is_removed"", ""krs"", ""last_entry_date"", ""last_entry_no"", ""last_state_entry_date"", ""last_state_entry_no"", ""legal_form"", ""name"", ""name_short"", ""nip"", ""regon"", ""type"", ""w_likwidacji"", ""w_upadlosci"", ""w_zawieszeniu"", ""relations"", ""birthday"", ""first_name"", ""krs_person_id"", ""last_name"", ""organizations_count"", ""second_names"", ""sex""}, " & _
            "{""Column1.address"", ""Column1.business_insert_date"", ""Column1.ceo"", ""Column1.current_relations_count"", ""Column1.data_fetched_at"", ""Column1.first_entry_date"", ""Column1.historical_relations_count"", ""Column1.id"", ""Column1.is_opp"", ""Column1.is_removed"", ""Column1.krs"", ""Column1.last_entry_date"", ""Column1.last_entry_no"", ""Column1.last_state_entry_date"", ""Column1.last_state_entry_no"", ""Column1.legal_form"", ""Column1.name"", ""Column1.name_short"", ""Column1.nip"", ""Column1.regon"", ""Column1.type"", ""Column1.w_likwidacji"", ""Column1.w_upadlosci"", ""Column1.w_zawieszeniu"", ""Column1.relations"", ""Column1.birthday"", ""Column1.first_name"", ""Column1.krs_person_id"", ""Column1.last_name"", ""Column1.organizations_count"", ""Column1.second_names"", ""Column1.sex""})" & Chr(13) & "" & Chr(10) & _
        "in" & Chr(13) & "" & Chr(10) & _
        " #""Expanded Column1"""
End Function

如果这是您问题中的真正API密钥/凭证，那么您可能希望服务器提供者吊销/更改它（以便没有人可以使用您的凭据使用此服务API）。
没有实施错误处理，并且当前用户的输入没有以任何方式得到验证/清除。

Answer 2

嗨，我实现了您的方法。但是我遇到了2个问题：

当我在定义的范围内单击并添加查询时运行宏时，范围被“缩短”到仅我刚刚单击的字段。因此，“ idselected”而不是A2：A10现在变成了A2 ...
查询已成功添加，并且参数已成功传递，但是当我运行查询并添加新工作表时，发生错误：

“表的工作表数据必须与表在同一工作表上”

我现在的最终VBA代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.CountLarge <> 1 Then Exit Sub
    If Intersect(Target.Parent.Range("Range5"), Target) Is Nothing Then Exit Sub

    With ThisWorkbook
        .Names("Range5").RefersTo = Target



        .Queries.Add Name:="2-1_1", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & " Source = Json.Document(Web.Contents(""https://rejestr.io/api/v1/krs/"" & Excel.CurrentWorkbook(){[Name=""Range5""]}[Content]{0}[Column1] & ""/relations"", [Headers=[Authorization=""xxxxxxx""]]))," & Chr(13) & "" & Chr(10) & " #""Converted to Table"" = Table.FromList(Source, Splitter.SplitByNothing(), null, null, ExtraValues.Error), " & Chr(13) & "" & Chr(10) & " #""Expanded Column1"" = Table.ExpandRecordColumn(#""Con" & _
    "verted to Table"", ""Column1"", {""address"", ""business_insert_date"", ""ceo"", ""current_relations_count"", ""data_fetched_at"", ""first_entry_date"", ""historical_relations_count"", ""id"", ""is_opp"", ""is_removed"", ""krs"", ""last_entry_date"", ""last_entry_no"", ""last_state_entry_date"", ""last_state_entry_no"", ""legal_form"", ""name"", ""name_short"", ""nip"", ""regon"", ""type"", ""w_likwidacji"", ""w_upadlo" & _
    "sci"", ""w_zawieszeniu"", ""relations"", ""birthday"", ""first_name"", ""krs_person_id"", ""last_name"", ""organizations_count"", ""second_names"", ""sex""}, {""Column1.address"", ""Column1.business_insert_date"", ""Column1.ceo"", ""Column1.current_relations_count"", ""Column1.data_fetched_at"", ""Column1.first_entry_date"", ""Column1.historical_relations_count"", ""Column1.id"", ""Column1.is_opp"", ""Column1.is_rem" & _
    "oved"", ""Column1.krs"", ""Column1.last_entry_date"", ""Column1.last_entry_no"", ""Column1.last_state_entry_date"", ""Column1.last_state_entry_no"", ""Column1.legal_form"", ""Column1.name"", ""Column1.name_short"", ""Column1.nip"", ""Column1.regon"", ""Column1.type"", ""Column1.w_likwidacji"", ""Column1.w_upadlosci"", ""Column1.w_zawieszeniu"", ""Column1.relations"", ""Column1.birthday"", ""Column1.first_name"", ""Column1.krs_person_id"", ""Column1.last_name"", ""Column1.organizations_count"", ""Column1.second_names"", ""Column1.sex""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Expanded Column1"""
       ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=2-1_1;Extended Properties=""""" _
        , Destination:=Range("$S$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [2-1_1]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_2_1_1"
        .Refresh BackgroundQuery:=False
    End With
    End With

如何动态将单元格值作为新PowerQuery的参数传递？

2 个答案: