シーゴの Excel 研究室

タイトル変更しました （旧称：今日を乗り切るExcel研究所）

トップ > VBA > 【VBA】ワークシートのデータを Power Query で加工したい【100本ノック】

【VBA】ワークシートのデータを Power Query で加工したい【100本ノック】

VBA

続けてエクセルの神髄様の Twitter 企画 「VBA100本ノック」の 74 本目を取り上げます。

お題：VBA100本ノック 74本目：1シート複数表をDB形式に変換

問題ページ

方針

複数の表の結合（合併）と、横持から縦持ちへの表組み換えをするというよくある課題の組み合わせです。

ただしデータ構成がちょっとイジワルで複雑になっているのでやり応えがありそうです。

ところで最近、この手のデータ加工作業は Power Query で簡単にできるようになったので、VBA の出番もだいぶ減りました。

Power Query は、ファイルやデータベース、Webなど様々なデータソースからデータを収集し（取得）、データの結合、連結、絞り込み、補完、組み換え、正規化といったデータを整える（データ前処理）の加工操作（変換）を自動化できる高度な機能です。Excel 2016 から標準サポートされています。

今回の縦持ちへの表組み換えも Power Query の「ピボット解除」という機能を使えば簡単にできてしまいます。

とはいえ、Power Query なら何でもできるというわけではありません。

今回のイジワル課題のようなイレギュラーなシートデータを Power Query の機能だけで正規化するのはかなり苦戦するでしょう。

現実の業務なら、今回のような集計データには元データがあるはずなのでそれを提供してもらい、Power Query で集計しなおすのが正しい解決策ですが、そうは言ってもレガシーな業務フローではそうもいかないこともママあるでしょう。

そこにまだ VBA が活躍できる余地があります。

VBA で複雑なデータ構造をある程度正規化し、Power Query が扱いやすいテーブル形式へと変換するという、いわば前処理の前処理への活用です。

解答

Option Explicit

Sub VBA100_074()
    Application.ScreenUpdating = False
    
    Dim 売上集計 As Workbook
    Set 売上集計 = ActiveWorkbook
    売上集計.Worksheets("DB").UsedRange.ClearContents
    
    ' 作業用の新規ワークブックとしてシートをコピーする
    売上集計.Worksheets(Array("売上", "DB")).Copy
    
    With ActiveWorkbook ' 作業用ワークブック
        Dim ar As Range
        For Each ar In .Worksheets("売上").UsedRange.Columns(1).SpecialCells(xlCellTypeConstants).Areas
            Call 売上のテーブル化(ar.CurrentRegion)
        Next
        
        Call 売上の結合とピボットの解除(.Worksheets("DB"))
        
        With .Worksheets("DB").UsedRange
            売上集計.Worksheets("DB").Range(.Address).Value = .Value
        End With
        
        .Close False
    End With
    
    売上集計.Worksheets("DB").Activate
    Application.ScreenUpdating = True
End Sub

Private Sub 売上のテーブル化(rng As Range)
    Dim src As Range
    Set src = Intersect(rng, rng.Offset(1))
    
    With rng.Worksheet.ListObjects.Add(xlSrcRange, src, , xlYes)
        .ListColumns("1Q計").Delete
        .ListColumns("2Q計").Delete
        .ListColumns("3Q計").Delete
        .ListColumns("4Q計").Delete
        With .ListColumns.Add(1)
            .Name = "取引先CD"
            .DataBodyRange.Value = rng.Range("A1").Value
        End With
        With .ListColumns.Add(2)
            .Name = "取引先名"
            .DataBodyRange.Value = rng.Range("B1").Value
        End With
    End With
End Sub

Private Sub 売上の結合とピボットの解除(sht As Worksheet)
    Dim query As String
    query = Join(Array( _
            "let" & _
            "    src = Excel.CurrentWorkbook()," & vbCrLf & _
            "    tbls = Table.SelectRows(src, each not Text.StartsWith([Name], ""★""))," & vbCrLf & _
            "    union = Table.Combine(tbls[Content])," & vbCrLf & _
            "    unpivot = Table.UnpivotOtherColumns(union, {""取引先CD"", ""取引先名"", ""商品CD"", ""商品名""}, ""年月"", ""金額"")," & vbCrLf & _
            "    result = Table.TransformColumnTypes(unpivot,{{""年月"", type date}, {""金額"", Int64.Type}})" & vbCrLf & _
            "in" & vbCrLf & _
            "    result" _
        ), vbCrLf)

    sht.Parent.Queries.Add Name:="売上クエリ", Formula:=query
    
    sht.Activate
    With sht.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=売上クエリ;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [売上クエリ]")
        .ListObject.DisplayName = "★売上クエリテーブル"
        .Refresh BackgroundQuery:=False
    End With
End Sub

　

　

考察

解答例のロジックは以下のような流れになっています。

  1. 作業用ワークブックにデータのワークシートをコピー
  2. 「売上」シートの各データをテーブル化
  3. Power Queryで各テーブルを取り込み、「結合/追加」した上で「ピボットの解除」を実行
  4. 元ブックの「DB」シートにクエリ結果の出力データをコピー

作業用ワークシート

マクロの実行後にはなるべく出力以外の余計な変更をワークブックに残したくないものです。

セル範囲をテーブル化するのは簡単なのですが、逆にセル範囲に戻したときにはテーブルのスタイルが残ったりして元どおりにはなりません。

また、ブックに追加した Power Query のクエリは後始末で削除しますが、何か痕跡が残るかもしれません。

このような副作用などに気を使いたいくないときは、シートを一時的な作業用ワークブックにコピーしてそこでデータを加工し、最後に結果データだけを戻すようにします。 作業用ブックを削除してしまえば後腐れもありません。

デバッグで動作を追ってみるには、最初の Application.ScreenUpdating = False をコメントアウトしてください。

テーブル化

Power Query で Excel のワークシート上のデータを取り込ませる場合、入力データは基本的に Excel テーブル（青いシマシマ）になっている必要があります。

「売上」シートのデータは取引先ごとに複数の表に分かれていて、取引先データが列外にあり、四半期の計算列を持つなど、非正規形のデータ構造になっています。

これらをVBAで、フラットなテーブル形式（Tabular Format、本題でいうDB形式）にある程度変換（正規化）したうえで、 Excel テーブル化する必要があります。

とはいえ解答例では、テーブルの方が Range を操作するロジックよりも簡単で分かりやすかったので、テーブル化の方を先に行っています。

f:id:shego:20210830013944p:plain

Power Query の呼び出し

テーブルが用意できれば、あとは「データの取得と変換」の「テーブルまたは範囲から」を使って Power Query に取り込めばＯＫです。

ところが実際にやってみると、テーブルの数だけクエリを１個１個作成する必要があって、それらをまた別クエリとして結合することになり、クエリの組み立てが面倒くさいです。

そこで、Power Query の実行も VBA からやってしまうことにします。

VBA から Power Query のクエリの呼び出し方は「マクロの記録」をしてみればわかりますが、これをテーブルの数だけ繰り返すのも汎用性がなく芸のない話です。

クエリの中身を編集し、１個のクエリでまとめて済ませてしまいましょう。

クエリの編集

Power Query のクエリは M 言語 という言語で記述されるプログラムです。「Power Query エディター」内の「詳細エディター」で編集できます。

最初に Power Query エディターで自動記録させたコードを適宜編集してカスタマイズする、というのは VBA マクロと同様です。

本記事では M 言語の解説までできませんが、クエリの各ステップで何をやっているのか、簡単な説明を以下にコメントで追記しました。

let
    // ブック内の全てのテーブルを取得する
    src = Excel.CurrentWorkbook(),
    // このクエリ自体の結果出力であるテーブルを除外する（テーブル名が「★」で始まるものを除外する）
    tbls = Table.SelectRows(src, each not Text.StartsWith([Name], "★")),
    // 各テーブルを結合（Union）する
    union = Table.Combine(tbls[Content]),
    // 「年月」でピボット解除をする
    unpivot = Table.UnpivotOtherColumns(union, {"取引先CD", "取引先名", "商品CD", "商品名"}, "年月", "金額"),
    // 「年月」と「金額」の列の型を設定する
    result = Table.TransformColumnTypes(unpivot,{{"年月", type date}, {"金額", Int64.Type}})
in
    result

ポイントは最初に呼ばれる Excel.CurrentWorkbook という関数です。

この関数はクエリのあるワークブック内にある全ての Excel テーブルを返します。

通常のUI（「データの取得と変換」）から取り込んだクエリでは、その中から指定のテーブルを１個だけ取り出していますが、 あえてテーブル名の指定なしで始めれば、クエリを分けなくても全テーブルをソースにしてクエリを組み立てることができます。

let
    ソース= Excel.CurrentWorkbook()
in
    ソース

ただし、クエリの結果のテーブル（緑のシマシマ）も含まれてしまうので、これを除外するフィルター処理が必要です。 解答のクエリでは結果のテーブルに区別できるテーブル名（先頭文字に「★」）をつけてそれを除外しています。

他にも Error になるデータを除外する必要があるかもしれません。 Excel.CurrentWorkbook 関数で取得できるデータは、厳密にはテーブルだけでなく名前の付いたセル範囲のようなのですが、 単なるフィルターのついたリスト表が拾われてなぜか Error になるからです。

テーブル化されていないデータを取り込みたい場合には Excel.Workbook という関数で外部ファイルとして取り込みます。

Excel.Workbookでは Excel テーブルだけではなく、オートフィルタの付いたリストや、シート上のセル範囲も問題なく取得することができます。

参考資料

関連記事

www.shegolab.jp

www.shegolab.jp

www.shegolab.jp