【ExcelVBA】列を指定して値の種類ごとに別のExcelファイルに分けて行データを出力させるには

この記事では、列を指定して値の種類ごとに別のExcelファイルに分けて行データを出力させる方法についてご説明します。

すぐにソースコードを見たい場合はこちらをクリック

Table of Contents

【動画】列を指定して値の種類ごとに別のExcelファイルに分けて行データを出力させる実際の動き

本題に入る前に、まずは次の動画をご覧ください。

指定した項目の値の種類を取得し、その値に該当する行データを取得しています。

取得後は、新たにExcelファイルを作成してそのExcelファイルのシートに行データを貼り付けて保存しています。

マクロ作成の流れ

STEP.1

表のデータ件数と列数を取得する

表のデータ件数と列数を取得します。

STEP.2

条件に指定した項目名が表の何列目にあるのか位置を特定する

条件に指定した項目名が表の何列目にあるのか位置を特定します。

STEP.3

STEP.2で取得した項目名の位置を元に、その項目列のセルの値を取得する

STEP.2で取得した項目名の位置を元に、その項目列のセルの値を取得します。

STEP.4

STEP.3で取得したセルの値から重複した値を除いた一意の値を取得する

STEP.3で取得したセルの値から重複した値を除いた一意の値を取得します。

STEP.5

STEP.4の値が存在するセルのデータ行を、SELECT文を実行して取得する

STEP.4の値が存在するセルのデータ行を、SELECT文を実行して取得します。

STEP.6

STEP.5で取得したデータを出力するためのExcelファイルを新規作成する

STEP.5で取得したデータを出力するためのExcelファイルを新規作成します。
なお、Excelファイル名にはSTEP.4で取得した一意の値を指定します。

STEP.7

STEP.6で新規作成したExcelファイルを保存して閉じる

STEP.6で新規作成したExcelファイルを保存して閉じます。

目次へ戻る

Excelファイルの例

今回は次のExcelファイルを用意しました。

シート「top」：項目の入力欄(セルA5)とExcelファイルの保存先(セルA2)が用意されている

シート「work」：取得元のデータの表を用意

目次へ戻る

コードの例

Excelのマクロのコード(例)

Option Explicit

Private Sub btn_exec_Click()

    Dim dicCnt          As Long                 'Dictionary用カウンタ変数
    Dim conn            As ADODB.Connection     'ADODB.Connectionオブジェクトのインスタンス用変数
    Dim rs              As ADODB.Recordset      'レコードセット用変数(配列のソート用)
    Dim saveDataPath    As String               '生成したExcelファイルの保存先
    Dim tblLstRowPos    As Long                 '表の最後列格納用変数
    Dim cnt             As Long                 'カウンタ用変数1
    Dim cnt2            As Long                 'カウンタ用変数2
    Dim tblFndColPos    As Long                 '検索する列名格納用変数
    Dim tblArray()      As Variant              '取得する項目の(表の)値を保持する配列
    Dim itemDic         As Dictionary           'Dictionary用変数
    Dim sqlStr          As String               'SQL文用変数
    Dim newWB           As Workbook             '新規作成するExcelファイル用変数
    
    'カウンタの値を初期化する
    dicCnt = 1
    
    'Connectionインスタンスの生成
    Set conn = New ADODB.Connection
    
    'Recordsetオブジェクトのインスタンスを生成する(配列のソート用)
    Set rs = New ADODB.Recordset
    
    '抽出したデータの保存先を取得する
    saveDataPath = Worksheets("top").Range("saveDataPath").Value
        
    With conn

        '接続情報の取得(自分自身のExcelファイルに接続する)
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source = " & ThisWorkbook.FullName & _
        ";Extended Properties =Excel 12.0;"

        'データソースへの接続を開く
        .Open

    End With

    'Recordsetを開く(表の件数と列数取得)
    rs.Open " [" & "data$" & "]", conn, adOpenStatic
    
    'データの件数を取得する
    tblLstRowPos = CLng(rs.RecordCount)
    
    'フィールドを一つ一つ確認してコンボボックスの項目名が列の何番目にあるのか特定するためのループ
    For cnt = 0 To rs.Fields.Count
    
        If Worksheets("top").Range("termsStr").Value = rs.Fields(cnt).Name Then
        
            'コンボボックスに入力された項目とrecordsetの項目名が同じ場合
            
            'カウンタの値を取得する(カウンタ+1の値がコンボボックスの項目名が列名に存在する位置)
            tblFndColPos = cnt + 1
        
            'ループを抜ける
            Exit For
        
        End If
    
    Next
    
    'recordsetを閉じる
    rs.Close
    
    With Worksheets("data")
    
        '取得する項目の(表の)値を配列tblArrayに格納する
        tblArray = .Range(.Cells(2, tblFndColPos), .Cells(tblLstRowPos + 1, tblFndColPos)).Value
            
    End With
        
    'Dictionaryオブジェクトのインスタンスを生成する
    Set itemDic = New Dictionary
    
    '配列tblArrayの数だけ処理を繰り返す
    For cnt = 1 To UBound(tblArray) - 1
    
        If itemDic.Exists(tblArray(cnt, 1)) = False Then
        
            'Dictionaryのインスタンスに配列の値が存在していない場合
            
            'Dictionaryのインスタンスに配列の値を追加する
            itemDic.Add tblArray(cnt, 1), tblArray(cnt, 1)
            
            If IsEmpty(itemDic.Items(dicCnt - 1)) = False Then
            
                '項目が表に存在している場合
                
                'シート上の表に対してデータを取得するSelect文を用意する
                sqlStr = "select * from"
                sqlStr = sqlStr & " [data$]"        'シート名を指定する
                sqlStr = sqlStr & " where "
                sqlStr = sqlStr & Worksheets("top").Range("termsStr").Value & "= '" & _
                                  itemDic.Items(dicCnt - 1) & "'"
                                
                'Recordsetを開く
                rs.Open sqlStr, conn, adOpenStatic
                        
                '取得したデータを貼り付けるための新たなExcelファイルを作成する
                Set newWB = Workbooks.Add
                            
                '表の列数分だけ処理をループする
                For cnt2 = 0 To rs.Fields.Count - 1
                
                    '表の列名をセルに出力する
                    newWB.Worksheets(1).Cells(1, cnt2 + 1).Value = rs.Fields.Item(cnt2).Name
                    
                Next cnt2
            
                '先ほど貼り付けた列名の下の行にデータを貼り付ける
                newWB.Worksheets(1).Cells(2, 1).Offset(0, 0).CopyFromRecordset rs
                
                '新規作成したExcelファイルに名前を付けて保存する
                Call newWB.SaveAs(saveDataPath & "\" & itemDic.Items(dicCnt - 1) & ".xlsx")
                
                '新規作成したExcelファイルを閉じる
                newWB.Close
                        
                'recordsetを閉じる
                rs.Close
            
            Else
            
                '項目が表に存在している場合
                
                '何もしない

            End If
                        
            dicCnt = dicCnt + 1
            
            DoEvents
            
        End If
        
        DoEvents
    
    Next cnt
    
    'Connectionを切断する
    conn.Close
    
    '後処理
    Set conn = Nothing
    Set itemDic = Nothing
    
End Sub

注目すべきコード①

最初に見て頂きたいのは22行目から25行目です。

    'Connectionインスタンスの生成
    Set conn = New ADODB.Connection
    
    'Recordsetオブジェクトのインスタンスを生成する(配列のソート用)
    Set rs = New ADODB.Recordset

以上のコードは、各インスタンスを生成するコードです。

23行目では、マクロがExcelファイルに接続するのに必要なConnectionオブジェクトのインスタンスを生成しています。

26行目では、配列のソートするのに必要なrecordsetオブジェクトのインスタンスを生成しています。

注目すべきコード②

最初に見て頂きたいのは22行目から25行目です。

    With conn

        '接続情報の取得(自分自身のExcelファイルに接続する)
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source = " & ThisWorkbook.FullName & _
        ";Extended Properties =Excel 12.0;"

        'データソースへの接続を開く
        .Open

    End With

以上のコードは、マクロが自分自身のExcelファイルにADO接続するためのコードになります。

ADO接続するために必要なConnectionインスタンスに対してADO接続するために26行目から28行目で接続情報を設定します。

なお、27行目では自分自身のExcelファイルをフルパスで指定しています。

自分自身のExcelファイルのフルパスはThisWorkbook.FullNameプロパティから取得することができます。

注目すべきコード③

次に見て頂きたいのは43行目から63行目です。

    'Recordsetを開く(表の件数と列数取得)
    rs.Open " [" & "data$" & "]", conn, adOpenStatic
    
    'データの件数を取得する
    tblLstRowPos = CLng(rs.RecordCount)

以上のコードは、Recordsetを開いた後にデータの件数を取得するコードです。

43行目のRecordsetオブジェクトのOpenメソッドに、「注目すべきコード②」で説明した自分自身のExcelファイルにあるシート「data」を引数に指定して実行しています。

Openメソッドの実行が正常終了すると、Recordsetにシート「data」の表のデータが取得されるので、46行目でその表のデータの件数をRecordCountプロパティから取得し変数「tblLstRowPos」に格納しています。

なおRecordCountの型はLongLong型ですがこの型をそのまま使いたくないので、Long型に型を変換するためのClng関数を使っています。

注目すべきコード④

次に見て頂きたいのは49行目から63行目です。

    'フィールドを一つ一つ確認してコンボボックスの項目名が列の何番目にあるのか特定するためのループ
    For cnt = 0 To rs.Fields.Count
    
        If Worksheets("top").Range("termsStr").Value = rs.Fields(cnt).Name Then
        
            'コンボボックスに入力された項目とrecordsetの項目名が同じ場合
            
            'カウンタの値を取得する(カウンタ+1の値がコンボボックスの項目名が列名に存在する位置)
            tblFndColPos = cnt + 1
        
            'ループを抜ける
            Exit For
        
        End If
    
    Next
    
    'recordsetを閉じる
    rs.Close

以上のコードは、シート「top」の項目を入力するセルに入力された項目名が、表の何列目の列の項目に存在するのか特定するコードです。

49行目では、表の列の数分ループを繰り返すfor文を用意し、51行目でコンボボックスで選ばれている項目名と表の列名が合致するかを判定します。

もしコンボボックスで選ばれている項目名と表の列名が合致している場合は、何行目かが特定できたので56行目で何行目かを変数「tblFndColPos」に格納します。
(カウンタ変数に1を足した値が何行目かに当たります)

66行目では、Recordsetを使う必要なくなったのでCloseメソッドで閉じておきます。

注目すべきコード⑤

次に見て頂きたいのは68行目から73行目です。

    With Worksheets("data")
    
        '取得する項目の(表の)値を配列tblArrayに格納する
        tblArray = .Range(.Cells(2, tblFndColPos), .Cells(tblLstRowPos + 1, tblFndColPos)).Value
            
    End With

以上のコードは、コンボボックスで選択された項目名に合致する列のセルの値を配列「tblArray」に取得するコードです。

セルの値は、rangeオブジェクトに指定したセルの範囲をそのまま配列に代入することで一括で取得することができます。

注目すべきコード⑥

次に見て頂きたいのは76行目から88行目と125行目から131行目です。

    'Dictionaryオブジェクトのインスタンスを生成する
    Set itemDic = New Dictionary
    
    '配列tblArrayの数だけ処理を繰り返す
    For cnt = 1 To UBound(tblArray) - 1
    
        If itemDic.Exists(tblArray(cnt, 1)) = False Then
        
            'Dictionaryのインスタンスに配列の値が存在していない場合
            
            'Dictionaryのインスタンスに配列の値を追加する
            itemDic.Add tblArray(cnt, 1), tblArray(cnt, 1)
            
            If IsEmpty(itemDic.Items(dicCnt - 1)) = False Then

            Else
            
                '項目が表に存在している場合
                
                '何もしない
            End If

以上のコードは、Dictionaryオブジェクトを使って配列の値にある重複した値を除いた一意の値を取り出す処理のコードです。

列を指定して値の種類ごとに別シートに分けて行データを出力させるには、セルの値を種類別に一意で値を取得する必要があります。

今回はDictionaryオブジェクトのインスタンスを使って一意で値を取得しています。

76行目では、Dictionaryオブジェクトのインスタンスを生成します。

79行目では、配列の要素数分処理を繰り返すFor文を用意しています。

81行目では、配列の値がDictionaryオブジェクトのインスタンスに存在しているかExistメソッドで確認します。

もし配列の値がDictionaryオブジェクトのインスタンスに存在していない場合は、配列の値をDictionaryオブジェクトのインスタンスにAddメソッドを実行して追加します。

存在しなければ何もしません。

この存在チェックと追加処理を繰り返すことで一意の値を取得することができます。

88行目のIf文では、指定した項目の値がセルにあるかを判定します。
(IsEmpty関数の判定がFalseなら、IsEmpty関数の引数に指定された値がEmpty値ではない、つまり値があるということです。)

もしある場合(Empty値ではない場合)は93行目の処理(「注目すべきコード⑦」)を行い、無い場合(Empty値の場合)は125行目のElseの条件に合致しElseの処理を行います。

今回のサンプルでは、Elseの場合は特に何も処理を行いません。
(指定した項目の値がセルにある場合の時だけ処理(SELECT文の実行やExcelファイルの新規作成など)を行います)

注目すべきコード⑦

次に見て頂きたいのは93行目から100行目です。

            'シート上の表に対してデータを取得するSelect文を用意する
            sqlStr = "select * from"
            sqlStr = sqlStr & " [data$]"        'シート名を指定する
            sqlStr = sqlStr & " where "
            sqlStr = sqlStr & Worksheets("top").Range("termsStr").Value & "= '" & _
                              itemDic.Items(dicCnt - 1) & "'"
                            
            'Recordsetを開く
            rs.Open sqlStr, conn, adOpenStatic

以上のコードは、「注目すべきコード⑥」で取得した一意の値を条件に該当するデータ行を取得するSELECT文を用意するコードです。

From句には表が存在するシート(今回のサンプルでは「work」)指定しています。(94行目)

Where句にはコンボボックスで選択された項目名が一意の値に該当するデータ行を抽出する条件を指定しています。(96行目と97行目)

今回のサンプルのExcelファイルは次の通りにコンボボックスの選択やデータが入力されて上記のコードが実行されます。

なお、コードだけではSelect文が分かりにくいと思うので、実際に実行するSQLをサンプルで以下にお見せします。

select
    *
from
    [data$]
where
    都道府県名 = '千葉県'

このSELECT文は、項目の入力欄(セルA5)には都道府県名が入力されていて、まずは都道府県名が千葉県に該当するデータ行を抽出するSELECT文です。

以上のSELECT文は、都道府県名の種類分繰り返し実行されます。

注目すべきコード⑧

次に見て頂きたいのは103行目から123行目です。

                '取得したデータを貼り付けるための新たなExcelファイルを作成する
                Set newWB = Workbooks.Add
                            
                '表の列数分だけ処理をループする
                For cnt2 = 0 To rs.Fields.Count - 1
                
                    '表の列名をセルに出力する
                    newWB.Worksheets(1).Cells(1, cnt2 + 1).Value = rs.Fields.Item(cnt2).Name
                    
                Next cnt2
            
                '先ほど貼り付けた列名の下の行にデータを貼り付ける
                newWB.Worksheets(1).Cells(2, 1).Offset(0, 0).CopyFromRecordset rs
                
                '新規作成したExcelファイルに名前を付けて保存する
                Call newWB.SaveAs(saveDataPath & "\" & itemDic.Items(dicCnt - 1) & ".xlsx")
                
                '新規作成したExcelファイルを閉じる
                newWB.Close
                        
                'recordsetを閉じる
                rs.Close

以上のコードは、「注目すべきコード⑦」で取得したデータ行を出力するためのExcelファイルを新規作成、取得したデータをそのExcelファイルのシートに出力、名前を付けて保存、閉じる処理を行う処理のコードです。

103行目では、新規でExcelファイルを開きます。

106行目から111行目では、表の列の数だけ繰り返しヘッダ(列名)をセルに出力しています。

109行目のFields.Item.Nameプロパティからヘッダ(列名)を取得することができます。

ヘッダ(列名)をセルに出力し終わったら114行目で、ヘッダ(列名)の1つ下のセル位置に結合させたデータをセルに貼り付けています。

117行目では、新規作成したExcelファイルに名前を付けて保存します。

なお、Excelファイルに付ける名前は都道府県名を使います。

120行目では、新規作成したExcelファイルを閉じます。

123行目では、Recordsetを閉じます。

このRecordsetを閉じる処理は、1つのexcelファイルに対して1回Openし、処理が終わったら必ずCloseさせる必要があります。(Openしている状態でもう一度Openを繰り返さない)

今回は同じrecordsetと(変数rs)を使いまわしているので、次のexcelファイルに対してrecordsetをOpenするときはかならずCloseさせた状態でOpenさせないとエラーになります。(Openしているのに何でまたOpenするの？と怒られます)

なので、かならずこのClose処理を行います。

目次へ戻る

動作確認

マクロ実行前

今回はExcelファイルの例のexcelファイルを使います。

シート「top」には以上のようにExcelファイルの保存先と、項目に「都道府県名」を入力しました。

マクロ実行後

マクロ実行後は、下の画面の通りにExcelファイルが作成されました。

各Excelファイルは、都道府県名の種類ごとに作成されています。

目次へ戻る

【注意】参照設定が必要です

一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。

参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。

Microsoft ActiveX Data Objects 2.8 Library(msado28.tlb)
Microsoft Scripting Runtime(scrrun.dll)

なぜ必要かというと、6行目と7行目の「ADODB.Connection」「ADODB.Recordset」というオブジェクトが「msado28.tlb」というファイルを、14行目の「Dictionary」というオブジェクトが「scrrun.dll」というファイルを参照するからです。

    Dim conn            As ADODB.Connection     'ADODB.Connectionオブジェクトのインスタンス用変数
    Dim rs              As ADODB.Recordset      'レコードセット用変数(配列のソート用)

    Dim itemDic         As Dictionary           'Dictionary用変数

この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。

ここでは「msado28.tlb」と「scrrun.dll」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「ADODB.Connection」「ADODB.Recordset」「Dictionary」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。

目次へ戻る