Excel-VBA 実例同じレイアウトの複数データを横に並べる

こんにちは！健史です。

同じレイアウトの複数のExcelデータを「横に並べて比較したい」ということありませんか。

２つの表であれば、
Aﾃｰﾌﾞﾙ Bﾃｰﾌﾞﾙ　
KEY1　KEY1
KEY2　
KEY3　KEY3
　　　 KEY14

さらに３つの表では、
Aﾃｰﾌﾞﾙ Bﾃｰﾌﾞﾙ Cﾃｰﾌﾞﾙ　
KEY1　KEY1　KEY1
KEY2　　　　 KEY2
KEY3　KEY3
　　　 KEY4　KEY4

というように。

SQLを使ったデータベース検索においては「FULL JOIN」という結合を使うようです。

今回、Excel-VBAで作成してみました。

既にあるファイルで同じことをやりたい、「FULL-JOIN」を実現できないデータベースを使われている方はご利用頂ければと思います。

尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。

Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。

Excel-VBA 実例この通りやれば動く、とにかく触ってみよう

こんにちは！健史です。パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。この記事は、Exceは知っているけれど・Excel-VBAって何？・Excel-VBAは取っ付きにくい！・Excel-VBAっ...

実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)

目　次　

プログラムの概要
プログラムの作成と実行
プログラムの詳細説明
制限事項
最後に
サンプルデータ

プログラムの概要

今回のサンプルプログラムは

レイアウトが同じＥｘｃｅｌデータで結合表(FULL JOIN)を作成する

イメージは以下です。

1.入力

2.出力
1).中間用ワーク

2).結合表

入力するファイルは「課別の果物輸入国ファイル」というファイルです。

そのようなファイルは無いと思いますが、要は同じ内容を別々に管理していて、キーとなるコードが統一されてないといったファイルを想定しています。

仕様概要は、以下の通りです。
・所定のフォルダに格納されている課別の果物輸入国ファイルを順次読み込む
・読み込んだデータをシート２の中間用ワークに格納する
・シート２の中間用ワークを１行にするためのキーでソートする
・ソートしたシート２の中間用ワークを読み込み、結合表を作成する

１行明細となっているデータを縦方向に見比べ、データの有無を確認したり、内容の違いを確認するのはたいへんです。

１つのシートの列データであれば見やすくなり、規則性やルール、改善すべき課題などが見えてくることもあると思います。

プログラムの作成と実行

1.データ準備
1).結合対象となるデータ
結合したいデータを[1.入力フォルダ]へ格納しておきます。

サンプルデータは後述の段落からExcelに貼り付けて作成します。

ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])

2.Excelを起動
1).シート１に以下のデータを貼り付ける
ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])

	フォルダ
入力フォルダ	G:\01.IN

プログラムを実行する場合のフォルダ名やファイル名は、実際の環境に合わせて修正します。

3.Excel-VBAを起動
Altを押した状態でF8キーを押します。

4.[マクロ名(M):]に'test'などマクロ名を入力(''は不要、testでなくsample1などでもよい)

5.[作成(C)]をクリック

6.以下のプログラムをドラッグ＆コピー

'①修正　シートの１列目から何列目まで処理対象にするかを指定
    Const j2_max As Long = 4
'フォルダ内のファイルを読み込むときの対象を定義、*は全てが対象
    Const cnsDIR = "\*.*"
'Ｅｘｃｅｌファイルを同時に２つ使うためオブジェクト変数として定義
    Dim excel1 As Workbook
    Dim excel0 As Workbook
'②修正　比較キーを追加・削除　１項目の場合は[svKey1]、２項目の場合は[svKey1, svKey2]
    Dim svKey1, svKey2 As String
'変数を定義
    Dim i1, i1_max, i2, i2_max, i3 As Long
    Dim j2, j2_base As Long
    Dim cntFile As Long
    Dim cntFileName As String
'フォルダやファイルの場所用の変数を定義
    Dim strPath1 As String
'結合対象フォルダから取得するファイル名用の変数を定義
    Dim strFilename As String
'フォルダやファイルの場所をワークに取り込む
    strPath1 = Sheets(1).Cells(2, 2)
'指定のフォルダが存在しない場合は、、メッセージを表示して終了
    If Dir(strPath1, vbDirectory) = "" Then
        MsgBox "結合対象フォルダがない", vbExclamation
        Exit Sub
    End If
'現在開いているＥｘｃｅｌマクロのオブジェクトをexcel0に取得
    Set excel0 = ActiveWorkbook
'処理用中間シート(データを統合し結合キーでソートするシート)をクリア
    excel0.Sheets(2).Cells.Clear
'結合表シート(最終的に生成される比較シート)をクリア
    excel0.Sheets(3).Cells.Clear
'結合対象フォルダ内の最初のファイルを取得
    strFilename = Dir(strPath1 & cnsDIR, vbNormal)
    i2 = 1
    cntFile = 0
    Do While strFilename <> ""
        cntFile = cntFile + 1
        cntFileName = Left(strFilename, InStrRev(strFilename, ".") - 1)
        Set excel1 = Workbooks.Open(strPath1 & "\" & strFilename)
        i1_max = excel1.Sheets(1).Range("A1").End(xlDown).Row
'処理用中間シートに見出し付与
        If excel0.Sheets(2).Cells(1, 1) = "" Then
            excel1.Sheets(1).Rows(1).Copy
            excel0.Sheets(2).Rows(1).PasteSpecial
            excel0.Sheets(2).Cells(1, j2_max + 1) = "シート順"
        End If
'結合表シートに見出し付与
        excel0.Sheets(3).Cells(1, (cntFile - 1) * j2_max + 1) = cntFileName
        For j2 = 1 To j2_max
            excel0.Sheets(3).Cells(2, (cntFile - 1) * j2_max + j2) = _
                excel0.Sheets(2).Cells(1, j2)
        Next
'結合対象フォルダ内のＥｘｃｅｌシートから処理用中間シートに転記
        For i1 = 2 To i1_max
            i2 = i2 + 1
            excel1.Sheets(1).Rows(i1).Copy
            excel0.Sheets(2).Rows(i2).PasteSpecial
            excel0.Sheets(2).Cells(i2, j2_max + 1).NumberFormatLocal = "G/標準"
            excel0.Sheets(2).Cells(i2, j2_max + 1) = cntFile
        Next
'結合対象フォルダ内のＥｘｃｅｌシートを上書きしないで閉じる
        Call excel1.Close(False)
'次のファイル名を取得
        strFilename = Dir()
    Loop
'処理用中間シートに格納した最大値を保存
    i2_max = i2
'処理用中間シートを結合キーでソート
'③修正　比較する項目数分を追加・削除し、[Key?],[Range("??"]を修正する
    excel0.Sheets(2).UsedRange.Sort _
        Key1:=excel0.Sheets(2).Range("A1"), Order1:=xlAscending, _
        Key2:=excel0.Sheets(2).Range("B1"), Order2:=xlAscending, _
        Header:=xlYes
'処理用中間シートから結合表シートに配置処理
    i2 = 2
    i3 = 2
    Do Until i2 > i2_max
'④修正　比較する項目数分を追加・削除し、[svKey?], [Cells(i2 ,?)]を修正する
        svKey1 = excel0.Sheets(2).Cells(i2, 1)
        svKey2 = excel0.Sheets(2).Cells(i2, 2)
        i3 = i3 + 1
'⑤修正　比較する項目数分を追加・削除し、[svKey?], [Cells(i2 ,?)]を修正する
        Do Until svKey1 <> excel0.Sheets(2).Cells(i2, 1) Or _
                 svKey2 <> excel0.Sheets(2).Cells(i2, 2) Or _
                 i2 > i2_max
            j2_base = excel0.Sheets(2).Cells(i2, j2_max + 1) - 1
            For j2 = 1 To j2_max
                excel0.Sheets(3).Cells(i3, j2_base * j2_max + j2) = _
                    excel0.Sheets(2).Cells(i2, j2)
            Next
            i2 = i2 + 1
        Loop
    Loop

7.以下に貼り付け(ペースト)

Sub test()
ここに貼り付ける
End Sub

8.F5キーで実行

9.実行結果の確認
シート２[中間用ワーク]、シート３[結合表]にそれぞれ読み込んだファイルからのデータが格納・編集されています。

プログラムの詳細説明

処理対象フォルダからファイ名を取得し結合表を作成する対象ファイルをフォルダから読み込む処理は、以下の記事を参照下さい。

Excel-VBA 実例重複チェックして重複データを抽出する

こんにちは！健史です。「Excelシートのある列項目が重複しているデータを探したい！」ということありませんか。 Excelの「COUNTIF 関数」を使えばできますが、処理データを現場にありそうなフォルダ情報から作成し、重複チェックする...

For文については、以下の記事を参照下さい。

Excel-VBA 実例この通りやれば動く、とにかく触ってみよう

複数のExcelファイルを同時に使うことについては、以下の記事を参照下さい。

Excel-VBA 実例 Excelの文字列を一括検索・置換

こんにちは！健史です。Ｅｘｃｅｌファイルで保管されている文書の文字列を一括で修正したいということありませんか。プログラムで指定したフォルダ内のＥｘｃｅｌファイルの文字列を修正する処理を作成してみました。尚この記事は、Excel-VB...

追加で補足します。

文字列の抽出

    cntFileName = Left(strFilename, InStrRev(strFilename, ".") - 1)

ファイル名が例えば[1課.01.xls]の場合、抽出したい内容は拡張子を除いた[1課.01]を想定しています。

[1課.01.xls]の場合、全体は9文字です。

1桁目:1　2桁目:課　3桁目:.　4桁目:0　5桁目:1　6桁目:.　7桁目:x　8桁目:l　9桁目:s

[InStrRev(strFilename, ".")]では、後ろから最初に見つかった "."の位置、位置は先頭から数えた位置、すなわち[6]が求まります。

そして計算式[省略・・ ".") - 1)]は、[6-1]で[5]が求まり、Left関数で左から5桁を抽出します。

今回検索する文字を"."にして後ろからの検索にしたのは、拡張子[xls][xlsx][txt]などに関わらず使えるからです。

尚、文字列抽出の説明は、以下でも記載しています。

参考：ファイル名から名前だけを抽出

行のコピー＆ペースト

    excel1.Sheets(1).Rows(1).Copy
    excel0.Sheets(2).Rows(1).PasteSpecial

読み込んだファイルから[中間用ワーク]シートに項目を１つひとつコピーするのではなく、行単位でコピーします。

データや処理の補足説明

1.データ
1).項目[備考]は使っていない
プログラムの先頭

'①修正　シートの１列目から何列目まで処理対象にするかを指定」
    Const j2_max As Long = 4

で、[j2_to]に4をセットしています。

1課.xls、2課.xls、3課.xlsの処理対象は[区コード]～[輸入国]までで、5番目の項目[備考]は使わないことを意味しています。

[備考]は補足説明で「このプログラムで処理する、３つのファイルを合わせたときにどのようなデータなのか」をコメントとして記載しています。

2).中間用ワークの項目[シート順]は読み込んだファイルの順番
「３つのファイルを合わせた結合表を作成するときにデータをどの位置に配置するか」を示す項目で、ファイルを読み込んだ順番を設定しています。

制限事項

制約事項がいくつかあります。

◇起動したＥｘｃｅｌファイルには３つのシートが必要

以下３つのシートが必要です。
1.入力フォルダ
結合表を作成する対象ファイルが格納されているフォルダを指定します。
　
2.中間用ワーク
処理の流れは、上記[入力フォルダ]のファルダより対象ファイルを読み込み、１つのデータにしてから[結合表]を作成します。

[1.]で読み込んだデータを１つのデータにして、ソート後に１件目から順次読み込み[3.]を作成しますが、そのためのシートです。
　
3.結合表
[中間用ワーク]のデータを読み込み、最終的に作成する結合表です。

◇結合する基のファイルはレイアウトが同じ
[入力フォルダ]に格納してある処理するデータは、全て同じレイアウトである必要があります。

「同じレイアウト」とは「列」のことで、処理する列の個数・順番が同じでなければなりません。

処理対象列は、[A][B][C][D][E]と連続することが条件です。

例えば[F]列を抜きにして[A][B][C][D][E][G][H]などでは処理できません。

異なるレイアウトの結合表を作成する場合を考えてみました。
・作成する中間用ワークでキーの位置を合わせておく、(A列、B列など)
・異なるレイアウトの列数を控えておき、中間用ワークから結合表を作成するときに異なるレイアウトの列数を項目コピーする
・中間用ワークの[シート順]の列は、項目数の最も多いシートの列を指定する(j2_maxのこと)
でしょうか。

◇プログラム修正が必要
当記事に記載するプログラムは、
・処理するデータの列数が4つ
　[A]列～[D]列
・結合キー数が2つ
　[A]列と[B]列
です。

ですから、
①処理する列数が2つ、3つ、5つ以上の場合
②結合キーの数か結合するキーの位置が変更になる場合
は修正が必要です。

尚、修正箇所はプログラム内に記載しています。

◇データ量に制限がある
[1.入力フォルダ]から読み込み中間用ワークシートに格納できるデータ量はEXCELのバージョンによって異なります。

列数も同様で、例えばEXCEL2003の場合は256列までしか扱えないので「ファイル数×処理する列数」が256列を超える場合は処理できません。

尚、当記事のプログラムは行数・列数とも上限をチェックしていません。

ご認識の上でご利用下さい。

最後に

[FULL JOIN]はニーズが少ないのしょうか、ネット上の記事は少ないというか、控えめというかに思います。

使うシーンに応じて対応して頂ければと思います。

サンプルデータ

1課.xls

区コード	果物コード	名称	輸入国	備考
01	1001	バナナ	フィリピン	3つにあり
02	2001	パイナップル	フィリピン	１だけ
03	3001	グレープフルーツ	南アフリカ	１２にあり
03	3003	パパイヤ	フィリピン	１３にあり

2課.xls

区コード	果物コード	名称	輸入国	備考
01	1001	バナナ	エクアドル	3つにあり
02	2002	キウイフルーツ	ニュージーランド	２だけ
03	3001	グレープフルーツ	アメリカ	１２にあり
03	3002	マンゴー	メキシコ	２３にあり

3課.xls

区コード	果物コード	名称	輸入国	備考
01	1001	バナナ	台湾	3つにあり
02	2003	オレンジ	オーストラリア	３だけ
03	3002	マンゴー	タイ	２３にあり
03	3003	パパイヤ	アメリカ	１３にあり