読者です 読者をやめる 読者になる 読者になる

ぼくLog

子持ち、車持ち、マンション持ちの僕の日常を綴ります。車と、ラクをしたい一心で覚えたエクセルVBAを中心になりそうです。

エクセルのシートをデータベースのテーブルとして扱うとめちゃくちゃ簡単にデータを加工できる!|エクセルVBA

エクセル VBA マクロ

エクセルで表データを扱うときに、その表をデータベースのテーブルとして扱うとものすっごぉぉっく簡単に扱えるようになります。


例えばこういった住所録があったとします。

f:id:yt4u:20170102225905j:plain

(住所録はなんちゃって個人情報で生成したダミーデータです。)

このなかの「性別」「年齢」「婚姻」を使って、データを抽出するとします。

例えばこうです。性別=男性 かつ 年齢=30歳以上50歳未満、かつ 婚姻=未婚、という条件でデータを抽出して、別シートにその結果を出力する。

これをVBAを使って行う場合、どのような方法が考えられるか?

  1. エクセルのデータベース関数を使う
  2. シート上の表データを一行ずつチェックして指定条件に該当するデータを別シートに転記する
  3. シート上の表データにオートフィルタを掛け、オートフィルタを操作することで指定条件に該当するデータを抽出し、別シートにコピーする
  4. シート上の表データをデータベースのテーブルと見なして、指定条件を踏まえたSQLを実行しレコードセットを別シートに出力する


このエントリーのタイトルの通り今回のテーマは4です。
なので4のやり方を詳しく見ていくことになるのですが、その他の手段に関するメリット・デメリットに触れておきます。

1は正直ぼくはやったことがありません(汗

如何せんデータベース関数のヘルプを見るとすごく分かりにくい。
関数を使う前にヘルプで挫折しちゃいます。結果使ったことがないんです。

ひとつ言えることは、データベース関数の使い方を覚えるくらいなら、4の方法を覚えてしまった方が何倍も幸せです。

次に、簡単に2、3でどうやるかに触れるならば、
2は単純に「For~Next」で各行の抽出対象列の値をチェックしていくことになるでしょうし、3は抽出対象列でAutofilter Field:=aaa, Criteria1:=“bbb"」といったようにフィルタを実行していくことになると思います。

2、3だダメというわけではなく、目的は十分に果たせますので問題ありません。ただ、抽出条件をアレコレ変えたりする際に煩わしさを感じることになると思います。


一方で4の場合そういった煩わしさがありません。

その煩わしさはないのですが事前準備がちょっと必要です。
それはエクセルをデータベースとして扱えるようにするための準備です。


エクセルをデータベースとして扱うための準備

最初に示した住所録を持つエクセルのブックにADO接続をします。
ADOとは何ぞ?はWikipediaあるいはMicrosoftへGo!!(上手く説明できないので他人任せ!)

で、接続するためのコードはコチラ。

Public Function GetXLSConnection(DataSource As String) As Object

  Dim objCN             As Object
  Dim strCNString       As String
  
  
  Set objCN = CreateObject("ADODB.Connection")
  
  
  strCNString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                        & "Data Source=" & DataSource & ";" _
                        & "Extended Properties=""Excel 8.0;" _
                        & "HDR=Yes"";"


  objCN.Open strCNString
  
  
  Set GetXLSConnection = objCN
  

End Function


これでエクセルのブックにADO接続を行う準備が出来ました。

実際に接続(コネクションを確立)するサンプルは次のようになります。

Public Sub コネクションサンプル()

  Dim objCN             As Object
  
  'コネクションを確立
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)

End Sub


レコードセットを取得

次に抽出条件を書いたSQLを実行し、その結果であるデータの塊(レコードセット)を受け取る準備をします。

そのコードがコチラ

Private Const adOpenDynamic       As Long = 2
Private Const adLockOptimistic    As Long = 3

Public Function GetRecordSet(strSQL As String, objCN As Object) As Object

  Dim objRS             As Objectc
  
  
  Set objRS = New ADODB.Recordset
  
  
  objRS.Open strSQL, objCN, adOpenDynamic, adLockOptimistic
  
  
  Set GetRecordSet = objRS
  
  
End Function

引数として受け取ったデータベースコネクションの下、SQLを実行し、生成されたレコードセットを返しています。


コネクションとレコードセットを破棄することも忘れずに

忘れたからといって自分ひとりで使う分には何ら問題はありませんが、複数人で使うことになった場合に何かしら不具合が生じる可能性があります。
共有ブックを複数人で弄ると不具合が発生するのに似ていますね。

コネクションの破棄とレコードセットの破棄のコードはこうです。

'==========================================================
'コネクション破棄
'==========================================================
Public Sub CloseConnection(objCN As Object)


  If objCN.State <> adStateClosed Then
  
    objCN.Close
  
  End If
  
  
  Set objCN = Nothing
  

End Sub


'==========================================================
'レコードセット破棄
'==========================================================
Public Sub CloseRecordSet(objRS As Object)


  If objRS.State <> adStateClosed Then
  
    objRS.Close
  
  End If


  Set objRS = Nothing
  
  
End Sub


ここまでで、ブックへの接続とレコードセットを生成する準備、そしてその接続(コネクション)とレコードセットを破棄する準備が整いました。
次に、実際にデータの抽出となります。


データを抽出してみよう!

まずはデータ抽出のコードを示します。 前提として、最初に載せたシート上の表に、セルの名前の定義で「rngXDB_DataBase」と名付けています。 そして抽出したデータを出力するシートのCodeNameを「wsXLSDataBase」、またそのシート上のデータを出力する一番左上のセルを「rngXDB_DataTop」を名付けています。

Public Sub DataGetSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngF              As Long
  
  
  'コネクションを確立
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  '抽出条件を作成
    strSQL = "SELECT"                                           '抽出フィールド(項目)を指定
      strSQL = strSQL & "  [名前]"
      strSQL = strSQL & ", [ふりがな]"
      strSQL = strSQL & ", [電話番号]"
      strSQL = strSQL & ", MONTH([誕生日]) AS [誕生月]"
    strSQL = strSQL & " FROM rngXDB_DataBase"                   'データテーブルを指定
    strSQL = strSQL & " WHERE 1 = 1"                            '抽出条件
      strSQL = strSQL & " AND [性別] = '男'"                    '性別=男
      strSQL = strSQL & " AND [年齢] >= 30"                     '年齢=30歳以上
      strSQL = strSQL & " AND [年齢] <  50"                     '50歳未満
      strSQL = strSQL & " AND [婚姻] = '未婚'"                  '婚姻=未婚
  
  
  '抽出実行
    Set objRS = GetRecordSet(strSQL, objCN)
  
  
  '抽出結果を出力
    With wsXLSDataBase
    
      With .Range("rngXDB_DataTop")

        
        '出力エリアにある既存データを消去
          .CurrentRegion.ClearContents
          
        
        'フィールド(項目)名を出力
          For lngF = 0 To objRS.Fields.Count - 1
          
            .Offset(, lngF).Value = objRS.Fields(lngF).Name
          
          Next lngF
          
        
        'データを出力
          .Offset(1).CopyFromRecordset objRS
          
    
      End With
    
    End With
  
  
END_PROC:

  'レコードセットを閉じる
    Call CloseRecordSet(objRS)
  
  'コネクションを閉じる
    Call CloseConnection(objCN)


End Sub

上から順を追って見てみると、

  1. データベースと見立てたエクセルブックへのコネクションを確立する
  2. データ抽出条件を書く
  3. データ抽出を実行し、レコードセットをゲット
  4. 抽出したデータを出力する場所を綺麗にする
  5. レコードセットのフィールド名をまずは書き出し
  6. レコード群を一気に出力する
  7. 最後にレコードセットとコネクションを破棄

という流れになっています。

抽出条件を変える場合は2のところ(SQL文)を書き換えればOK。 抽出条件の値をセルから拾ってくるようにすれば、非常に簡単に好きなようにデータを取ってこれるようになります。



改めてコード全文を示します。

Option Explicit

Private Const adOpenDynamic       As Long = 2
Private Const adLockOptimistic    As Long = 3
Private Const adStateClosed       As Long = 0


'==========================================================
'コネクションを返す
'==========================================================
Public Function GetXLSConnection(DataSource As String) As Object

  Dim objCN             As Object
  Dim strCNString       As String
  
  
  Set objCN = CreateObject("ADODB.Connection")
  
  
  strCNString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                        & "Data Source=" & DataSource & ";" _
                        & "Extended Properties=""Excel 8.0;" _
                        & "HDR=Yes"";"


  objCN.Open strCNString
  
  
  Set GetXLSConnection = objCN
  

End Function


'==========================================================
'レコードセットを返す
'==========================================================
Public Function GetRecordSet(strSQL As String, objCN As Object) As Object

  Dim objRS             As Object
  
  
  Set objRS = CreateObject("ADODB.Recordset")
  
  
  objRS.Open strSQL, objCN, adOpenDynamic, adLockOptimistic
  
  
  Set GetRecordSet = objRS
  
  
End Function


'==========================================================
'コネクション破棄
'==========================================================
Public Sub CloseConnection(objCN As Object)


  If objCN.State <> adStateClosed Then
  
    objCN.Close
  
  End If
  
  
  Set objCN = Nothing
  

End Sub


'==========================================================
'レコードセット破棄
'==========================================================
Public Sub CloseRecordSet(objRS As Object)


  If objRS.State <> adStateClosed Then
  
    objRS.Close
  
  End If


  Set objRS = Nothing
  
  
End Sub


'==========================================================
'データ取得サンプル
'==========================================================
Public Sub DataGetSample()

  Dim objCN             As Object
  Dim objRS             As Object
  Dim strSQL            As String
  Dim lngF              As Long
  
  
  'コネクションを確立
    Set objCN = GetXLSConnection(ThisWorkbook.FullName)
  
  
  '抽出条件を作成
    strSQL = "SELECT"                                           '抽出フィールド(項目)を指定
      strSQL = strSQL & "  [名前]"
      strSQL = strSQL & ", [ふりがな]"
      strSQL = strSQL & ", [電話番号]"
      strSQL = strSQL & ", MONTH([誕生日]) AS [誕生月]"
    strSQL = strSQL & " FROM rngXDB_DataBase"                   'データテーブルを指定
    strSQL = strSQL & " WHERE 1 = 1"                            '抽出条件
      strSQL = strSQL & " AND [性別] = '男'"                    '性別=男
      strSQL = strSQL & " AND [年齢] >= 30"                     '年齢=30歳以上
      strSQL = strSQL & " AND [年齢] <  50"                     '50歳未満
      strSQL = strSQL & " AND [婚姻] = '未婚'"                  '婚姻=未婚
  
  
  '抽出実行
    Set objRS = GetRecordSet(strSQL, objCN)
  
  
  '抽出結果を出力
    With wsXLSDataBase
    
      With .Range("rngXDB_DataTop")
     
        
        '出力エリアにある既存データを消去
          .CurrentRegion.ClearContents
          
        
        'フィールド(項目)名を出力
          For lngF = 0 To objRS.Fields.Count - 1
          
            .Offset(, lngF).Value = objRS.Fields(lngF).Name
          
          Next lngF
          
        
        'データを出力
          .Offset(1).CopyFromRecordset objRS
          
    
      End With
    
    End With
  
  
END_PROC:

  'レコードセットを閉じる
    Call CloseRecordSet(objRS)
  
  'コネクションを閉じる
    Call CloseConnection(objCN)


End Sub


データベース関連のコードはいつでも使えるようにスタンバイ

上記のデータベース関係のコード(コネクション確立、レコードセット取得、およびそれらの破棄)は一度用意しておけばいくらでも使い回しが出来ます。

使いたいときにコードを対象ブックの標準モジュールにコピペするでもいいですし、一連のコードをクラスにひとまとめにして、そのクラスをインポートすればいつでも使えるようにするでもいいと思います(クラス化については別機会に書きます)。