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

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

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

Table of Contents

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

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

シート「work」にあるコンボボックスには、シート「data」の表に対応した項目名が登録されています。

そのコンボボックスから項目名を選んで実行ボタンをクリックすると、その項目名に合致している列にあるデータを種類別に抽出して別シートにコピーします。

コピーするシートは項目名のデータの種類別に作られて、そのシートに項目名のデータに合致するデータ行がコピーされます。

マクロ作成の流れ

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で取得したデータを出力するためのシートを作成する

STEP.5で取得したデータを出力するためのシートを作成します。
なお、シート名にはSTEP.4で取得した一意の値を指定します。

STEP.7

STEP.5で取得したデータと列名を、STEP.6で作成したシートに出力する

STEP.5で取得したデータと列名を、STEP.6で作成したシートに出力します。

目次へ戻る

Excelファイルの例

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

シート「top」：項目のコンボボックスと実行ボタンが配置

シート「work」：表が存在している

目次へ戻る

コードの例

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

Option Explicit

Private Sub btn_test_Click()

    Dim cnt             As Integer              'カウンタ用変数
    Dim fCnt            As Integer              'カウンタ用変数(フィールドの列数カウント用)
    Dim dicCnt          As Integer              'Dictionary用カウンタ変数
    Dim conn            As ADODB.Connection     'ADODB.Connectionオブジェクトのインスタンス用変数
    Dim rng             As Range                'Rangeオブジェクト格納用変数
    Dim tblArray()      As Variant              '取得する項目の(表の)値を保持する配列
    Dim itemDic         As Dictionary           'Dictionary用変数
    Dim rs              As ADODB.Recordset      'レコードセット用変数(配列のソート用)
    Dim sqlStr          As String               'SQL文用変数
    Dim ws              As Worksheet            'ワークシート用変数
    Dim shtExistFlg     As Boolean              'シート存在確認フラグ
    Dim tblLstRowPos    As Long                 '表の最後列格納用変数
    Dim tblFndColPos    As Integer              '検索する列名格納用変数
    
    'カウンタの値を初期化する
    dicCnt = 1
    
    'Connectionインスタンスの生成
    Set conn = New ADODB.Connection
    
    'Recordsetオブジェクトのインスタンスを生成する(配列のソート用)
    Set rs = New ADODB.Recordset
        
    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 " [" & "work$" & "]", conn, adOpenStatic
    
    'データの件数を取得する
    tblLstRowPos = CLng(rs.RecordCount)
    
    'フィールドを一つ一つ確認してコンボボックスの項目名が列の何番目にあるのか特定するためのループ
    For cnt = 0 To rs.Fields.Count
    
        If Worksheets("top").cbx_itemList.Text = rs.Fields(cnt).Name Then
        
            'コンボボックスに入力された項目とrecordsetの項目名が同じ場合
            
            'カウンタの値を取得する(カウンタ+1の値がコンボボックスの項目名が列名に存在する位置)
            tblFndColPos = cnt + 1
        
            'ループを抜ける
            Exit For
        
        End If
    
    Next
    
    'recordsetを閉じる
    rs.Close
    
    With Worksheets("work")
    
        '取得する項目の(表の)値を配列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)
            
            'シート上の表に対してデータを取得するSelect文を用意する
            sqlStr = "select * from"
            sqlStr = sqlStr & " [work$]"        'シート名を指定する
            sqlStr = sqlStr & " where "
            sqlStr = sqlStr & Worksheets("top").cbx_itemList.Text & "= '" & _
                              itemDic.Items(dicCnt - 1) & "'"
                
            'Recordsetを開く
            rs.Open sqlStr, conn, adOpenStatic
                        
            'データを貼り付ける先のシート有無のチェック
            For Each ws In Worksheets
        
                If ws.Name = itemDic.Items(dicCnt - 1) Then
        
                    'データを貼り付ける先のシート名が存在している場合
        
                    '変数「shtExistFlg」にTrueを設定する
                    shtExistFlg = True
        
                End If
        
            Next ws
        
            If shtExistFlg = False Then
        
                'データを貼り付ける先のシートが存在しない場合
        
                'データを貼り付ける先のシートを新規作成する
                Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                               .Name = itemDic.Items(dicCnt - 1)
                               
            Else
        
                'データを貼り付ける先のシートが存在する場合
        
                'データを貼り付ける先のシートのセル全てをクリアする
                Worksheets(itemDic.Items(dicCnt - 1)).Cells.Clear
                                           
                'シートを作成したのでフラグをfalseで初期化する
                shtExistFlg = False
        
            End If
            
            '表の列数分だけ処理をループする
            For fCnt = 0 To rs.Fields.Count - 1
            
                '表の列名をセルに出力する
                Worksheets(itemDic.Items(dicCnt - 1)).Cells(1, 1 + fCnt).Value = rs.Fields.Item(fCnt).Name
                
            Next fCnt
            
            '先ほど貼り付けた列名の下の行にデータを貼り付ける
            Worksheets(itemDic.Items(dicCnt - 1)).Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
                    
            'recordsetを閉じる
            rs.Close
            
            dicCnt = dicCnt + 1
            
        End If
    
    Next cnt
    
    'Connectionを切断する
    conn.Close
    
    '後処理
    Set conn = Nothing
    Set itemDic = Nothing

End Sub

注目すべきコード①

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

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

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

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

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

注目すべきコード②

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

    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プロパティから取得することができます。

注目すべきコード③

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

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

以上のコードは、シート「work」にあるコンボボックスで選ばれている項目名が、表の何列目の列の項目に存在するのか特定するコードです。

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

もしコンボボックスで選ばれている項目名と表の列名が合致している場合は、何行目かが特定できたので54行目で何行目かを変数「tblFndColPos」に格納します。

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

注目すべきコード④

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

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

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

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

注目すべきコード⑤

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

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

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

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

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

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

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

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

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

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

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

注目すべきコード⑥

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

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

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

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

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

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

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

select
    *
from
    [work$]
where
    顧客名 = '自然食品スーパー'

このSELECT文は、コンボボックスには顧客名が選択されていて、まずは顧客名が自然食品スーパーに該当するデータ行を抽出するSELECT文です。

以上のSELECT文は、顧客名の種類分繰り返し実行されます。

注目すべきコード⑦

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

            'データを貼り付ける先のシート有無のチェック
            For Each ws In Worksheets
        
                If ws.Name = itemDic.Items(dicCnt - 1) Then
        
                    'データを貼り付ける先のシート名が存在している場合
        
                    '変数「shtExistFlg」にTrueを設定する
                    shtExistFlg = True
        
                End If
        
            Next ws
        
            If shtExistFlg = False Then
        
                'データを貼り付ける先のシートが存在しない場合
        
                'データを貼り付ける先のシートを新規作成する
                Worksheets.Add(After:=Worksheets(Worksheets.Count)) _
                               .Name = itemDic.Items(dicCnt - 1)
                               
            Else
        
                'データを貼り付ける先のシートが存在する場合
        
                'データを貼り付ける先のシートのセル全てをクリアする
                Worksheets(itemDic.Items(dicCnt - 1)).Cells.Clear
                                           
                'シートを作成したのでフラグをfalseで初期化する
                shtExistFlg = False
        
            End If

以上のコードは、取り込んだデータ行を出力させるシートを新規で作成するコードの処理です。

すでにシートが存在している場合はシートは作成しません。

97行目では、すでに存在するシートの数分処理を繰り返すFor文を呼び出し、99行目で種類別の一意の値に対して一つ一つ同じ名前のシートがないか判定します。

もしすでに同じ名前のシートが存在する場合は変数「shtExistFlg」にTrueを設定します。

この変数「shtExistFlg」は、Trueならすでにシートが存在する、Falseならシートは存在しないことを判定するためのフラグになります。

この変数「shtExistFlg」を110行目で判定するのに使います。

「shtExistFlg」がFalseなら115行目と116行目でシートを作成します。

「shtExistFlg」がTrueならシートの作成処理は行わずに、そのシートを123行目でクリアします。(データを取り込むために)

注目すべきコード⑧

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

            '表の列数分だけ処理をループする
            For fCnt = 0 To rs.Fields.Count - 1
            
                '表の列名をセルに出力する
                Worksheets(itemDic.Items(dicCnt - 1)).Cells(1, 1 + fCnt).Value = rs.Fields.Item(fCnt).Name
                
            Next fCnt
            
            '先ほど貼り付けた列名の下の行にデータを貼り付ける
            Worksheets(itemDic.Items(dicCnt - 1)).Cells(1, 1).Offset(1, 0).CopyFromRecordset rs
                    
            'recordsetを閉じる
            rs.Close

以上のコードは、取得したデータ行をセルに出力する処理とそのヘッダ(列名)をセルに出力する処理を行っているコードです。

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

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

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

目次へ戻る

動作確認

マクロ実行前

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

マクロ実行後

マクロ実行後は、下の画面の通りにシートが作成されます。

シートは、顧客名の種類ごとにシートが作成されています。

目次へ戻る

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

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

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

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

なぜ必要かというと、Excelのマクロのコードの8行目の「Dictionary」というオブジェクトが「scrrun.dll」というファイルを、9行目と10行目の「ADODB.Connection」「ADODB.Recordset」というオブジェクトが「msado28.tlb」というファイルを参照するからです。

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

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

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

目次へ戻る