ADOでExcelワークシートに接続

MDBではなく、Excelワークシートをデータベースとして、ADOで接続してみます。
私はこの方法を実務（仕事）で使ったことはありません。   「Excelブックを開かずにデータを取り出す」というような質問を掲示板などで時々見かけます。
一般的な回答は、ScreenUpdatingプロパティで画面描画を停止してから普通に開いて、直後に自ブックをActiveにした上で、後は開いたブックとしてやりとりすれば良いというものだと思います。
開かずにという目的は、「動作を見せない」が主目的でしょうが、中には「その方が高速」だと思い込んでいることもありそうです。 そこで、試しにADOでブックを参照／更新することをやってみることにします。 以前のページでお知らせしている通り、実行時にバインドの方法もありますが、 コードの理解や作成上で都合が良く厳密な比較では速いのだろうとのことで参照設定させた記述を使うことにします。
ワークシートにADOで接続する方法はあくまで「参考出品」であって、特段にお勧めする方法ではありません。(お勧めしません) 「本当に速いのか」「繰り返して動かしても問題ないか」などを皆さん自身で試すのにご利用下さい。



データベースとするワークブックはこんなイメージです。
こちらは「基本操作」の「分類ごとに集計がしたい。」で作成してあったシートで、このワークブックにはマクロも計算式もありません。
データベースとするブック
※この画像をクリックするとZIP圧縮ファイルがダウンロードされます。解凍すると「05_ADO_From_Worksheet.xlsm」と「SAMPLE_DB.xlsx」が現われるので、そのまま同じフォルダに保存させて下さい。
データベースとして扱うシートはこのような単純な見出しが１行だけのシートが適しているようで、場合によっては接続時にエラーになる場合もあります。
ADOで参照／更新する場合、シート名に「$」を付けたものがテーブル名、シートの１行目にある「部門」「大分類」「小分類」「金額」がフィールド名になります。

読み出しマクロを搭載したブックは単純そのものです。
サンプルマクロを搭載したワークブックは、単に新規ブックにマクロを書いただけにものです。
データベースを参照するマクロを搭載したブック
コードは次に提示しますが、「ADO_WS_TEST1」が読み出し用のサンプルマクロで、見出しも読み出すようにしてあります。
これを起動させてみると、
データベースからデータを読み出すマクロを起動
このようになります。
サンプルマクロそのままの状態では「小分類」が「分類Ｂ」のものを「大分類」順で抽出させています。 少量のデータサイズのブックなので読み出しに大して時間は掛かりませんが、「瞬時」でもありません。 ですが、読み出し後にシート上を消して再度読み出すと、初回よりはかなり速くなるのがお判りいただけると思います。 これはADOのプール機能あたりのおかげなのでしょうか。

では、上記のサンプルコードです。
ご覧のように、以前のページで紹介しているMDBに対するADOの記述と大きく違いません。
このサンプルでは、データベースとなるExcelブックを「SAMPLE_DB.xlsx」とし、 その所在を読み出すマクロの方のワークブックと同じフォルダとしていますが、コードを理解して改変すれば自在に変更することが可能です。

'***************************************************************************************************
'   ADOでWorksheetに接続する                                        Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'   [参照設定]
'   ・Microsoft ActiveX Data Objects 2.x Library
'   ・Microsoft ADO Ext, 2.x for DDL and Security    ←ADO_WS_TEST3でのみ使用
'   ・Microsoft Scripting Runtime
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'06/02/13(1.00)新規作成
'07/10/07(1.01)初回修正
'20/02/29(1.10)*.xlsm化、他
'21/07/16(1.20)データファイルを*.xlsx化
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsProvider As String = "Microsoft.ACE.OLEDB.12.0"
Private Const g_cnsExtProp As String = "Extended Properties"
Private Const g_cnsExcel As String = "Excel 12.0"
Private Const g_cnsDBName As String = "SAMPLE_DB.xlsx"

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名　：ADO_WS_TEST1
'* 機能　　：シートをテーブルとして内容を受け取る
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2006年02月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub ADO_WS_TEST1()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim lngRow As Long                                              ' 行INDEX
    Dim lngCol As Long                                              ' 列INDEX
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim strFullname As String                                       ' フルパス名
    Dim strSQL As String                                            ' SQL文
    '-----------------------------------------------------------------
    ' DBファイル名取得
    Set objFso = New FileSystemObject
    strFullname = objFso.BuildPath(ThisWorkbook.Path, g_cnsDBName)
    Set objFso = Nothing
    ' Connection生成
    Set dbCon = New ADODB.Connection
    With dbCon
        .Provider = g_cnsProvider
        .Properties(g_cnsExtProp) = g_cnsExcel
        ' データベースとしてOPEN
        .Open strFullname
    End With
    '-----------------------------------------------------------------
    ' SQL文作成
    'strSQL = "SELECT * FROM [Sheet1$]"     ' ←単純に全件転記ならこの記述
    strSQL = "SELECT * FROM [Sheet1$] WHERE 小分類='分類Ｂ' ORDER BY 大分類;"
    ' RecordSet取得(表示用)
    Set dbRes = New ADODB.Recordset
    dbRes.CursorLocation = adUseClient
    dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText
    ' シートクリア
    Cells.ClearContents
    '-----------------------------------------------------------------
    ' 見出し作成(普通は要らない！)
    lngIx = 0
    For lngCol = 1 To dbRes.Fields.Count
        Cells(1, lngCol).Value = dbRes.Fields(lngIx).Name
        ' 次へ
        lngIx = lngIx + 1
    Next lngCol
    '-----------------------------------------------------------------
    ' 明細のセット
    'Cells(2, 1).CopyFromRecordset dbRes    ' ←単純に全件転記ならこの記述でOK!
    lngRow = 1
    Do Until dbRes.EOF
        lngRow = lngRow + 1
        lngIx = 0
        For lngCol = 1 To dbRes.Fields.Count
            Cells(lngRow, lngCol).Value = dbRes.Fields(lngIx).Value
            lngIx = lngIx + 1
        Next lngCol
        ' 次へ
        dbRes.MoveNext
    Loop
    '-----------------------------------------------------------------
    ' 終了
    dbRes.Close
    dbCon.Close
    Set dbRes = Nothing
    Set dbCon = Nothing
End Sub
データ内容をシートに転記するのも、条件や処理によって転用できるようにあえてループ処理で1行1セルずつ転記させていますが、 レコードセットを全件単純に転記するので良ければ、その上のコメントにあるように「Cells(2, 1).CopyFromRecordset dbRes」の1行だけでOKです。

読み出した行に対して、「金額」を更新してみます。
このような接続方法でシート上のデータの更新が可能なのかも確認してみましょう。
ワークブックを開いて更新を行なう場合、「開く」「シート探索」「更新」「上書き保存」「閉じる」という工程になってしまいますから、 この方が逆にシンプルに見えます。

'***************************************************************************************************
'* 処理名　：ADO_WS_TEST2
'* 機能　　：シートをテーブルとして内容を更新する
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2006年02月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub ADO_WS_TEST2()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim lngRow As Long                                              ' 行INDEX
    Dim lngCol As Long                                              ' 列INDEX
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim crnGaku As Currency                                         ' 金額
    Dim strFullname As String                                       ' フルパス名
    Dim strSQL As String                                            ' SQL文
    Dim strMSG As String                                            ' メッセージ
    '-----------------------------------------------------------------
    ' DBファイル名取得
    Set objFso = New FileSystemObject
    strFullname = objFso.BuildPath(ThisWorkbook.Path, g_cnsDBName)
    Set objFso = Nothing
    ' Connection生成
    Set dbCon = New ADODB.Connection
    With dbCon
        .Provider = g_cnsProvider
        .Properties(g_cnsExtProp) = g_cnsExcel
        ' データベースとしてOPEN
        .Open strFullname
    End With
    '-----------------------------------------------------------------
    ' SQL文作成(11～21行目のデータを対象とする)
    strSQL = "[Sheet1$] WHERE 部門='部門１' AND 大分類='分類２' ORDER BY 小分類;"
    ' RecordSet取得(更新用)
    Set dbRes = New ADODB.Recordset
    dbRes.Open strSQL, dbCon, adOpenKeyset, adLockOptimistic, adCmdTable
    ' シートクリア
    Cells.ClearContents
    '-----------------------------------------------------------------
    ' 見出し作成(普通は要らない！)
    lngIx = 0
    For lngCol = 1 To dbRes.Fields.Count
        Cells(1, lngCol).Value = dbRes.Fields(lngIx).Name
        ' 次へ
        lngIx = lngIx + 1
    Next lngCol
    '-----------------------------------------------------------------
    Cells(1, lngCol).Value = "変更後"
    lngRow = 1
    ' 読み出して更新させる
    Do Until dbRes.EOF
        ' 現状をシートに書き出す
        lngRow = lngRow + 1
        lngIx = 0
        For lngCol = 1 To dbRes.Fields.Count
            Cells(lngRow, lngCol).Value = dbRes.Fields(lngIx).Value
            lngIx = lngIx + 1
        Next lngCol
        ' 金額の受け取り
        crnGaku = dbRes.Fields("金額").Value
        ' 金額を変更(受け取った額を２倍にしている)
        crnGaku = crnGaku * 2
        Cells(lngRow, lngCol).Value = crnGaku
        ' 金額を更新
        dbRes.Fields("金額").Value = crnGaku
        dbRes.Update
        ' 次へ
        dbRes.MoveNext
    Loop
    '-----------------------------------------------------------------
    ' 終了
    dbRes.Close
    dbCon.Close
    Set dbRes = Nothing
    Set dbCon = Nothing
End Sub
でも、複数箇所から同時に更新が行なわれたらうまくいくのでしょうか！？
などと不安になり、このような用途は普通にMDBを使えば良いのだろうなと考えるところです。

「シート名」が不明だったら？
ADOを使ってワークシートからデータ取得したいが、毎回シート名が変わってしまう、という質問を受けてやってみました。
これは、「MDBのテーブル定義内容を取得する。」で使用している方法の応用ですが、ワークブックに対しても同様に使えるようです。

'***************************************************************************************************
'* 処理名　：ADO_WS_TEST3
'* 機能　　：シートをテーブルとして内容を受け取る(シート名不定対応)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2006年02月13日
'* 作成者　：井上　治
'* 更新日　：2020年02月29日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub ADO_WS_TEST3()
    '-----------------------------------------------------------------------------------------------
    Dim dbCon As ADODB.Connection                                   ' ADODB.Connection
    Dim dbRes As ADODB.Recordset                                    ' ADODB.Recordset
    Dim adoCatalog As ADOX.Catalog                                  ' ADOX.Catalog
    Dim adoTbl As ADOX.Table                                        ' ADOX.Table
    Dim objFso As FileSystemObject                                  ' FileSystemObject
    Dim lngRow As Long                                              ' 行INDEX
    Dim lngCol As Long                                              ' 列INDEX
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim strFullname As String                                       ' フルパス名
    Dim strSQL As String                                            ' SQL文
    Dim strShName As String                                         ' シート名
    '-----------------------------------------------------------------
    ' DBファイル名取得
    Set objFso = New FileSystemObject
    strFullname = objFso.BuildPath(ThisWorkbook.Path, g_cnsDBName)
    Set objFso = Nothing
    ' Connection生成
    Set dbCon = New ADODB.Connection
    With dbCon
        .Provider = g_cnsProvider
        .Properties(g_cnsExtProp) = g_cnsExcel
        ' データベースとしてOPEN
        .Open strFullname
    End With
    '-----------------------------------------------------------------
    ' ADOXで接続して先頭のシート名を得る
    Set adoCatalog = New ADOX.Catalog
    Set adoCatalog.ActiveConnection = dbCon
    For Each adoTbl In adoCatalog.Tables
        If Left(adoTbl.Name, 4) <> "MSys" Then
            strShName = adoTbl.Name
            Exit For
        End If
    Next adoTbl
    Set adoCatalog.ActiveConnection = Nothing
    '-----------------------------------------------------------------
    ' SQL文作成
    'strSQL = "SELECT * FROM [Sheet1$]"     ' ←単純に全件転記ならこの記述
    strSQL = "SELECT * FROM [" & strShName & "] WHERE 小分類='分類Ｂ' ORDER BY 大分類;"
    ' RecordSet取得(表示用)
    Set dbRes = New ADODB.Recordset
    dbRes.CursorLocation = adUseClient
    dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText
    ' シートクリア
    Cells.ClearContents
    '-----------------------------------------------------------------
    ' 見出し作成(普通は要らない！)
    lngIx = 0
    For lngCol = 1 To dbRes.Fields.Count
        Cells(1, lngCol).Value = dbRes.Fields(lngIx).Name
        ' 次へ
        lngIx = lngIx + 1
    Next lngCol
    '-----------------------------------------------------------------
    ' 明細のセット
    'Cells(2, 1).CopyFromRecordset dbRes    ' ←単純に全件転記ならこの記述でOK!
    lngRow = 1
    Do Until dbRes.EOF
        lngRow = lngRow + 1
        lngIx = 0
        For lngCol = 1 To dbRes.Fields.Count
            Cells(lngRow, lngCol).Value = dbRes.Fields(lngIx).Value
            lngIx = lngIx + 1
        Next lngCol
        ' 次へ
        dbRes.MoveNext
    Loop
    '-----------------------------------------------------------------
    ' 終了
    dbRes.Close
    dbCon.Close
    Set dbRes = Nothing
    Set dbCon = Nothing
End Sub

'----------------------------------------<< End of Source >>----------------------------------------