Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Power Query вставка таблицы
 
На всякий случай добавлю весь макрос, может кто подскажет, как сделать так, чтобы лист не удалялся, а просто заново вставлял информацию на него
Код
Sub DeleteQuery()
    
    Dim M As String, qName As String, qDesc As String
    Dim qry As WorkbookQuery
    Dim answer As VbMsgBoxResult
    Dim LoadToDataModel As Boolean
    Dim loadToWorksheet As Boolean
    Dim currentSheet As Worksheet
    
    qName = ThisWorkbook.Worksheets("Sheet1").Cells(10, "D").Text
    qDesc = ThisWorkbook.Worksheets("Sheet1").Cells(10, "E").Text
    M = ThisWorkbook.Worksheets("Sheet1").Cells(10, "F").Text
    
    shouldLoadToDataModel = ThisWorkbook.Worksheets("Sheet1").Cells(13, "D")
    shouldLoadToWorksheet = ThisWorkbook.Worksheets("Sheet1").Cells(13, "E")
    ' We get from the first worksheets all the data in order to know which query to delete, including its worksheet, connection and Data Model is needed
    
    If shouldLoadToDataModel Or shouldLoadToWorksheet Then
        Dim con As WorkbookConnection
        Dim conString As String
                    
        For Each con In ThisWorkbook.Connections
            If Not con.InModel Then
                ' This is not a Data Model conenction. We created this connection without the "Power Query - " prefix, to determine if we should delete it, let's check the connection string
                If Not IsNull(con.OLEDBConnection) Then
                    ' This is a OLEDB Connection. Good chance it is our connection. Let's check the connection string
                    conString = con.OLEDBConnection.Connection
                    Dim prefix As String
                    prefix = "Provider=Microsoft.Mashup.OleDb.1;"
                    If (left(conString, Len(prefix)) = prefix) And (0 < InStr(conString, "Location=" & qName)) Then
                        ' This is our connection
                        ' It starts with "Provider=Microsoft.Mashup.OleDb.1;" and contains "Location=" with our query name. This is our connection.
                        con.Delete
                    End If
                End If
            ElseIf (InStr(1, con.Name, "Query - " & qName)) Then
                ' We created this connection with "Power Query - "  prefix, so we can this connection
                con.Delete
            End If
        Next
    End If
    
    If shouldLoadToWorksheet Then
        CleanSheet (qName)
    End If
    
    If DoesQueryExist(qName) Then
        ' Deleting the query
        Set qry = ThisWorkbook.Queries(qName)
        qry.Delete
    End If
         
End Sub

Sub CleanSheet(ByVal sheetName As String)
    ' Helper function to try to delete the worksheet if exists
    On Error Resume Next
    ThisWorkbook.Sheets(sheetName).Delete
End Sub

Function DoesQueryExist(ByVal queryName As String) As Boolean
    ' Helper function to check if a query with the given name already exists
    Dim qry As WorkbookQuery
    
    If (ThisWorkbook.Queries.Count = 0) Then
        DoesQueryExist = False
        Exit Function
    End If
    
    For Each qry In ThisWorkbook.Queries
        If (qry.Name = queryName) Then
            DoesQueryExist = True
            Exit Function
        End If
    Next
    DoesQueryExist = True
End Function

Sub CreateQuery()
    Dim M, qName, qDesc As String
    Dim qry As WorkbookQuery
    Dim currentSheet As Worksheet
    
    ' We load the query defintions from the first worksheet
    qName = ThisWorkbook.Worksheets("Sheet1").Cells(10, "D").Text
    qDesc = ThisWorkbook.Worksheets("Sheet1").Cells(10, "E").Text
    M = ThisWorkbook.Worksheets("Sheet1").Cells(26, "E").Text





    If DoesQueryExist(qName) Then
        ' This query already exists We will delete it first
        DeleteQuery
        ' In case we have worksheet that was created by this macro for the new query, let's delete it
        CleanSheet (qName)
    End If
    
    
    
    ' The new interface to create a new Power Query query. It gets as an input the query name, M formula and description
    Set qry = ThisWorkbook.Queries.Add(qName, M, qDesc)
    
    ' We check if data should be loaded to Data Model
    shouldLoadToDataModel = ThisWorkbook.Worksheets("Sheet1").Cells(13, "D")
    
    ' We check if data should be loaded to worksheet
    shouldLoadToWorksheet = ThisWorkbook.Worksheets("Sheet1").Cells(13, "E")
    
    If shouldLoadToWorksheet Then
        ' We add a new worksheet with the same name as the Power Query query
        Set currentSheet = Sheets.Add(After:=ActiveSheet)
        currentSheet.Name = qName
    
        If Not shouldLoadToDataModel Then
            ' Let's load to worksheet only
            LoadToWorksheetOnly qry, currentSheet
        Else
            ' Let's load to worksheet and Data Model
            LoadToWorksheetAndModel qry, currentSheet
        End If
    ElseIf shouldLoadToDataModel Then
        ' No need to load to worksheet, only Data Model
        LoadToDataModel qry
    End If
    
End Sub

Sub LoadToWorksheetOnly(query As WorkbookQuery, currentSheet As Worksheet)
    ' The usual VBA code to create ListObject with a Query Table
    ' The interface is not new, but looks how simple is the conneciton string of Power Query:
    ' "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name
 
    With currentSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1; Data Source=$Workbook$;Location=" & query.Name _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & query.Name & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False '
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True '
        .AdjustColumnWidth = True '
        .RefreshPeriod = 0
        .RefreshOnFileOpen = True
        .PreserveColumnInfo = False
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Sub LoadToWorksheetAndModel(query As WorkbookQuery, currentSheet As Worksheet)
    ' Let's load the query to the Data Model
    LoadToDataModel query
    
    ' Now we can load the data to the worksheet
    With currentSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _
        Connections("Query - " & query.Name), Destination:=Range("$A$1")).TableObject
        .RowNumbers = False
        .PreserveFormatting = True
        .PreserveColumnInfo = False
        .AdjustColumnWidth = True
        .RefreshStyle = 1
        .ListObject.DisplayName = Replace(query.Name, " ", "_") & "_ListObject"
        .Refresh
    End With
End Sub

Sub LoadToDataModel(query As WorkbookQuery)
    
    ' This code loads the query to the Data Model
    ThisWorkbook.Connections.Add2 "Query - " & query.Name, _
        "Connection to the '" & query.Name & "' query in the workbook.", _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & query.Name _
        , """" & query.Name & """", 6, True, False

End Sub


Power Query вставка таблицы
 
The_Prist,Сводная (в моем случае) - просто обычные поля.
Power Query вставка таблицы
 
The_Prist,Да, пробывал. Он вставит в ячейку АА1. По сути я бы мог в самую самую далекую ячейку вставить и это бы не было проблемой.
Пробывал также создавать другой лист и из него брать данные, но при этом если я заново запущу макрос на создание таблицы, то в сводной в формулах выскакивает #ССЫЛКА
Power Query вставка таблицы
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

На одном листе есть свод и я хочу вставлять данные на лист со сводом в определнные ячейки, чтобы потом воспользоваться формулами.
Power Query вставка таблицы
 
Доброе утро. Подскажите кто знает, как сделать так, чтобы данные из Power Query попадали на имеющийся лист.
Все это дело завязано через макрос, вот его кусок, который отвечает конкретно за загрузку данных на лист:
Код
Sub LoadToWorksheetOnly(query As WorkbookQuery, currentSheet As Worksheet)
 
    With currentSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1; Data Source=$Workbook$;Location=" & query.Name _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & query.Name & "]")

Если уже есть лист и я пытаюсь загрузить данные с таким же названием листа, то он просто перезатирает лист.
Буду благодарен за любую помощь или подсказку!
Изменено: vladislav109 - 04.05.2017 08:51:26
Страницы: 1
Наверх