Go to Qiita Advent Calendar 2024 Top
LoginSignup
9
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@hazigin(鞭輪打 辱銀)

Power Query With Excel VBA

Posted at

#0.Intro
仕事で必要になったので色々調べながらコーディングしてました。日本語情報がまだまだ少ないので調べたことをメモがてらシェアさせて頂きます。
とはいえそれほどまだ精通できているわけではないので細かいことはわかってません。また僕自身VBAから使いたかったのでPower Query Editorの方は大して調べてませんのにで書けません。主にDBの変わりとしてVBAから使う基本的な使い方のみ記載させて頂きます。
(2020/09/11　現在、仮公開の段階です)

#1.基本的な使い方。
Power Queryを使うにはまず何より、その名の通りデータ(つまりシート)をクエリに変換するところから始まります。

流れとしては、

Excelシートのデータ
↓
デーブル化
↓
クエリ作成

と進みます。

Power QueryにおいてSQLに相当する物はM言語です。僕自身まだ色々試してみないといけませんが、それほどにややこしいものではなさそうなのと、基本的に文字列で命令を出すので変数等も柔軟に織り込めそうです。

#2.目的別に纏めた関数
1.ExcelシートからPower Queryのクエリを作成

'------------------------------------------------
'  引  数：arg_sheet_name    対象シート
'  戻り値：生成されたクエリ名
'------------------------------------------------
Function ConvertTableToQuery(arg_sheet_name As String) As String
On Error GoTo HandleErr
    Dim Table_Name As String: Table_Name = arg_sheet_name & "_Table"
    Dim SheetName As String: SheetName = arg_sheet_name
    
    If IsQuerrExist(Table_Name) = True Then
        MsgBox Table_Name & ":Already Exist"
        ConvertTableToQuery = vbNullString
        Exit Function
    End If

    ThisWorkbook.Sheets(SheetName).ListObjects.Add(xlSrcRange, ThisWorkbook.Sheets(SheetName).Range("$A$1:$" & ConvNumToAlphabet(CountColumn(ThisWorkbook.Sheets(SheetName))) & "$" & CountRow(ThisWorkbook.Sheets(SheetName))), , xlYes).Name = Table_Name
    ThisWorkbook.Queries.Add Name:=Table_Name, Formula:="let Source = Excel.CurrentWorkbook(){[Name=""" & Table_Name & """]}[Content],  MODIED_TYPE = Table.TransformColumnTypes(Source,{" & GetShemaString(ThisWorkbook.Sheets(SheetName)) & "}) , AddIndex = Table.AddIndexColumn(MODIED_TYPE, ""Index_a"", 0, 1, Int64.Type) in AddIndex"
    
    ConvertTableToQuery = Table_Name
    Exit Function
HandleErr:
    MsgBox "Error ConvertTableToQuery:" & Err.Number & vbCrLf & "Description:" & Err.Description
    ConvertTableToQuery = vbNullString
End Function

2.クエリを作成する際に必要なカラム一覧1

'------------------------------------------------
'  引  数：対象シート
'  戻り値：カラム一覧
'------------------------------------------------
Function GetShemaString(SheetName As Worksheet)
    Dim ColumnArr() As String
    Dim i As Long
    Dim rec As String: rec = vbNullString
    Dim t_maxcol As Long
    t_maxcol = CountColumn(SheetName)
    
    
    For i = 1 To t_maxcol
        ReDim Preserve ColumnArr(i - 1)
        ColumnArr(i - 1) = "{""" & SheetName.Cells(1, i).value & """, type text}"
    Next i
    
    For i = 0 To UBound(ColumnArr)
        rec = rec & ColumnArr(i) & ","
    Next i
    
    rec = CutRight(rec, 1)
    
    GetShemaString = rec

End Function

3.クエリを外部結合でマージする(要はLEFT OUTER JOIN)

'------------------------------------------------
'  引  数：
'  arg_LeftQuery    結合の基準となるテーブル名
'  argRightQuery    他方のテーブル
'  Key_col    結合条件のカラム
'  MergeQueryName    生成するクエリ名
'  戻り値：True 成功 / False 失敗 
'------------------------------------------------
Function DistMergeQuery(arg_LeftQuery As String, argRightQuery As String, Key_col As String, MergeQueryName As String) As Boolean
On Error GoTo HandleErr
    
    ActiveWorkbook.Queries.Add Name:=MergeQueryName, Formula:="let Source = Table.NestedJoin(" & arg_LeftQuery & ", {""" & Key_col & """}, " & argRightQuery & ", {""" & Key_col & """}, """ & argRightQuery & """, JoinKind.LeftOuter),  Merged_Table = Table.ExpandTableColumn(Source, """ & argRightQuery & """, {" & GetShemaStringForMerge(ThisWorkbook.Sheets(Left(argRightQuery, Len(argRightQuery) - 6))) & "}, {" & GetShemaStringForMerge2(ThisWorkbook.Sheets(Left(argRightQuery, Len(argRightQuery) - 6))) & "}), AddIndex = Table.AddIndexColumn(Merged_Table , """ & MergeQueryName & "_Index" & """, 0, 1, Int64.Type) in AddIndex"
    DistMergeQuery = MergeQueryName
    
    If DistQueryToSheet(ThisWorkbook.Sheets("WorkQueryDist"), MergeQueryName, "$A$1") = False Then
        DistMergeQuery = False
        Exit Function
    End If
    DistMergeQuery = True
    Exit Function
HandleErr:
    MsgBox "Error DistMergeQuery:" & Err.Number & vbCrLf & "Description:" & Err.Description
    DistMergeQuery = False
End Function

4.マージする際に必要なカラム一覧1

'------------------------------------------------
'  引  数：対象シート
'  戻り値：カラム一覧
'------------------------------------------------
Function GetShemaStringForMerge(SheetName As Worksheet) As String
    Dim ColumnArr() As String
    Dim i As Long
    Dim rec As String: rec = vbNullString
    Dim t_maxcol As Long
    t_maxcol = CountColumn(SheetName)
    
    For i = 1 To t_maxcol
        ReDim Preserve ColumnArr(i - 1)
        ColumnArr(i - 1) = """" & SheetName.Cells(1, i).value & """"
    Next i
    
    For i = 0 To UBound(ColumnArr)
        rec = rec & ColumnArr(i) & ","
    Next i
    
    rec = CutRight(rec, 1)
    
    GetShemaStringForMerge = rec

End Function

5.マージする際に必要なカラム一覧2

'------------------------------------------------
'  引  数：対象シート
'  戻り値：カラム一覧
'------------------------------------------------
Function GetShemaStringForMerge2(SheetName As Worksheet) As String
    Dim ColumnArr() As String
    Dim i As Long
    Dim rec As String: rec = vbNullString
    Dim t_maxcol As Long
    t_maxcol = CountColumn(SheetName)
    
    For i = 1 To t_maxcol
        ReDim Preserve ColumnArr(i - 1)
        ColumnArr(i - 1) = """" & SheetName.Name & "_Table." & SheetName.Cells(1, i).value & """"
    Next i
    
    For i = 0 To UBound(ColumnArr)
        rec = rec & ColumnArr(i) & ","
    Next i
    
    rec = CutRight(rec, 1)
    
    GetShemaStringForMerge2 = rec

End Function

6.クエリの内容をExcelシートに出力する

'------------------------------------------------
'  引  数：対象シート
'  戻り値：True 成功 / False 失敗 
'------------------------------------------------
Function DistQueryToSheet(sheet As Worksheet, queryname As String, rangestr As String) As Boolean
On Error GoTo HandleErr
    With sheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryname & ";Extended Properties=""""" _
        , Destination:=sheet.Range(rangestr)).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryname & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = queryname
        .Refresh BackgroundQuery:=False
    End With
    DistQueryToSheet = True
    Exit Function
HandleErr:
    MsgBox "Error DistQueryToSheet:" & Err.Number & vbCrLf & "Description:" & Err.Description
    DistQueryToSheet = False
End Function

#3.Power Queryを使う際にあると便利な関数
1.テーブル化されたデータを解除し通常のシートに戻す

'------------------------------------------------
'  引  数：対象シート
'------------------------------------------------
Sub TableUnlist(sheet As Worksheet)
    On Error Resume Next
    Dim ls As ListObject
    
    For Each ls In sheet.ListObjects
        ls.TableStyle = ""
        ls.Unlist
    Next ls
End Sub

2.ブック中に同じ名前のクエリが存在しているかどうか確認

'------------------------------------------------
'  引  数：検査対象クエリ名
'  戻り値：True 存在する / False 存在しない
'------------------------------------------------
Function IsQuerrExist(qname As String) As Boolean
    Dim rec As Boolean: rec = False
    Dim wq As WorkbookQuery
    For Each wq In ThisWorkbook.Queries
          If InStr(1, wq.Name, qname) > 0 Then
            rec = True
          End If
    Next wq
    IsQuerrExist = rec
End Function
9
6
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
9
6

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?