ぼくLog

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

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

f:id:yt4u:20180212111117j:plain


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



データ追加編はこちら! yt4u.hatenablog.com



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

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.ACE.OLEDB.12.0;" _
                        & "Data Source=" & DataSource & ";" _

  '接続
    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

Private mstrErrDescription        As String


'==========================================================
'GetRecordset
'==========================================================
Public Function getRecordset( _
                        ByRef objCN As Object, _
                        ByVal strSQL As String, _
                        ByRef objRS As Object _
                        ) As Boolean
 
  
  getRecordset = False
  
  
  On Error GoTo ERR_PROC
  
  
  Set objRS = CreateObject("ADODB.Recordset")
  
  objRS.Open strSQL, objCN, adOpenDynamic, adLockOptimistic
  
  getRecordset = True
  
  
  GoTo END_PROC

ERR_PROC:
      
  MsgBox mstrErrDescription


END_PROC:
  
  
End Function

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


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

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

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

'==========================================================
'コネクション破棄
'==========================================================
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 GetDataSample()

  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 " & mcDataRangeName                'データテーブルを指定
    strSQL = strSQL & " WHERE 1 = 1"                            '抽出条件
      strSQL = strSQL & " AND [性別] = '男'"                    '性別=男
      strSQL = strSQL & " AND [年齢] >= 30"                     '年齢=30歳以上
      strSQL = strSQL & " AND [年齢] <  50"                     '50歳未満
      strSQL = strSQL & " AND [婚姻] = '未婚'"                  '婚姻=未婚
  
  
  '抽出実行     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If
  
  
  '抽出結果を出力
    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
  
  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox mstrErrDescription
  
  
END_PROC:

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


End Sub

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

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

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

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

SQL逆引き大全363の極意

SQL逆引き大全363の極意



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

Option Explicit

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

Private mstrErrDescription        As String

Private Const mcDataRangeName     As String = "rngXDB_DataBase"


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

  Dim objCN             As Object
  Dim strCNString       As String
  
  Set objCN = CreateObject("ADODB.Connection")
  
  strCNString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                        & "Data Source=" & DataSource & ";" _

  objCN.Open strCNString  
  
  Set GetXLSConnection = objCN  

End Function


'==========================================================
'GetRecordset
'==========================================================
Public Function getRecordset( _
                        ByRef objCN As Object, _
                        ByVal strSQL As String, _
                        ByRef objRS As Object _
                        ) As Boolean
 
  
  getRecordset = False
  
  
  On Error GoTo ERR_PROC  
  
  Set objRS = CreateObject("ADODB.Recordset")  
  
  objRS.Open strSQL, objCN, adOpenDynamic, adLockOptimistic  
  
  getRecordset = True
    
  GoTo END_PROC

ERR_PROC:
      
  mstrErrDescription = "レコードセット生成エラー"

END_PROC:  
  
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 GetDataSample()

  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 " & mcDataRangeName                'データテーブルを指定
    strSQL = strSQL & " WHERE 1 = 1"                            '抽出条件
      strSQL = strSQL & " AND [性別] = '男'"                    '性別=男
      strSQL = strSQL & " AND [年齢] >= 30"                     '年齢=30歳以上
      strSQL = strSQL & " AND [年齢] <  50"                     '50歳未満
      strSQL = strSQL & " AND [婚姻] = '未婚'"                  '婚姻=未婚
  
  '抽出実行     
    If getRecordset(objCN, strSQL, objRS) = False Then
         
      GoTo ERR_PROC
    
    End If  
  
  '抽出結果を出力  
    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  
  
  GoTo END_PROC
  
ERR_PROC:

  MsgBox mstrErrDescription  
  
END_PROC:

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

End Sub


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

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

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




[2019/03/10追記]

エクセルデータベースにSQLを使ってデータを追加します!

yt4u.hatenablog.com


[2018/12/19追記]

データベースで使われるレコードセット・オブジェクトを配列の代わりに使っちゃいます!

yt4u.hatenablog.com


[2018/02/10追記]

データベース処理用のクラスについてはこちらもご参照ください。

yt4u.hatenablog.com