Excel VBA 他のプログラムとの連係

Excel VBA のトップに戻る
Excel VBA 目次

VBAで他のプログラムを動かす(起動・終了)

ExcelのVBAで、Accessのデータを参照・更新する
 ・Access のデータを検索して、Excelに取り込む(Accessオブジェクト利用)
 ・Access のデータを使って、Excelのセルに貼り込む(連想配列を使う)
 ・Access Jet Engine のバージョンを調べる
 ・Access データベースをシーケンシャルに更新する(ADO接続)
(Excel の Ranking 関数のように順位を算出する)

 ・Excel VBA で Access のデータベースを最適化/修復
 ・dBASE データベースをシーケンシャルに参照する(ADO接続)

VBA で DOSコマンドを実行する

索引


Access のデータを使って、Excelのセルに貼り込む(連想配列を使う)

 下のマクロは、定められた様式の、複数の Excelブックの各品目番号に、対応する品目分類コードを付加するものです。
 このマクロは、Excelの該当セルに、Access の値を、直接貼り付けできる点が、特長です。

 この例の商社は、複数の支店から、定められた様式の Excelブックで送られてくる、「品目番号別売上げ明細」を、品目分類で集計しています。このため、前作業として、各品目番号に品目分類コードを付加する作業が必要なのです。
 この商社では、取り扱い品目番号が、400万点にもなるので、品目マスタは、Excel ではなく、Access DB を使って管理しています。

 マクロの使い方:
 支店から送られてきた複数のExcelブックを、一つのフォルダに登録します。
 そして、このマクロのExcelブックも、同じフォルダに保存します。
 フォルダから、Excelを開いて、このマクロを実行すると、ファイルを開くダイアログが表示されます。ここで、品目マスタの Access DB を指定します。
 Excel VBA は、Access DB に接続して、Excelの配列に「品目分類コード」を格納します。
 このとき、品目番号をキーとした連想配列に、配列の添え字を登録します。
 この配列を使って、フォルダに保存されている全てのExcelブックに対して、品目分類コードを付加します。
 品目番号をキーに、配列(400万件!)から該当品目番号の品目分類コードを参照するので、高速に処理できます。

追記:
Access のデータを検索して、Excelに取り込む(Accessオブジェクト利用)
との違いを確認してみて下さい。


Option Explicit
Option Base 1

   Dim 開始日時 As Variant
   Dim 終了日時 As Variant
   Dim データ配列(4000000) As String
   Dim 接続 As ADODB.Connection
   Dim Accessテーブル As ADODB.Recordset
   Dim 選択SQL As String
   Dim AccessDB名 As String
   Dim Accessテーブル名 As String
   Dim 処理内容 As String
   Dim データ件数 As Long
   Dim 現在のパス As String
   Dim AccessDBフルパス As String
   Dim 品番索引 As Object        'Scripting.Dictionary オブジェクト
   Dim 品番 As String
   Dim 指定セル As Range
   Dim 最終行 As Long
   Dim 処理行 As Long
   Dim 対象シート As Worksheet
   

Sub AccessDBのデータ付加()

   'パス切り替え
   ChDrive ThisWorkbook.Path
   ChDir ThisWorkbook.Path
   
   MsgBox "品目マスタ.mdb を指定します"
   AccessDBフルパス = Application.GetOpenFilename("Access DB,*.mdb")
   
   開始日時 = Now                ' 開始時刻を変数に格納します。
   
   Set 品番索引 = CreateObject("Scripting.Dictionary")    '★連想配列を定義★

   Call Access読み込み

   Call データ付加
   
   Set 品番索引 = Nothing
   
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


Private Sub Access読み込み()

   Accessテーブル名 = "品番コードマスタ"

   処理内容 = "Accessのテーブルを配列に読み込み"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   
   データ件数 = 0

   '★Accessのデータベースに接続して、テーブルをシーケンシャルに検索して更新
   'http://members.at.infoseek.co.jp/kenchan_h/index18.html

    'New キーワードを使用して新規Connectionオブジェクトを生成
    Set 接続 = New ADODB.Connection
    
    '接続
    接続.Open _
      "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Data Source=" & AccessDBフルパス
    
    'レコードセットの作成(SELECT文の実行)
    Set Accessテーブル = New ADODB.Recordset
    選択SQL = "SELECT * FROM " & Accessテーブル名
    
    'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
    'RecordsetオブジェクトのOpenメソッドを使います。
    'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
    'Recordsetオブジェクトの作成(ADO編)
    
    Accessテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
    
    '最終レコードまで順読み込みを行う
    Do Until Accessテーブル.EOF = True
      If IsNull(Accessテーブル("品目分類コード")) = False Then
      
         データ件数 = データ件数 + 1
          'Accessテーブルの、特定フィールドの値を所得します
          品番 = Accessテーブル("品番")

          データ配列(データ件数) = Accessテーブル("品目分類コード")
                   
          品番索引(品番) = データ件数  '★品番索引を作成★
          
          If データ件数 Mod 500000 = 0 Then
             処理内容 = "抽出件数 " & CStr(データ件数) & " 品番"
            Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
         End If
       End If
       
       'レコードの順読み
       Accessテーブル.MoveNext
    Loop
    
    'レコードセットのクローズ
    Accessテーブル.Close
    
    '接続を解除
    接続.Close
    'オブジェクトをクリア
    Set Accessテーブル = Nothing
    Set 接続 = Nothing

End Sub


Private Sub データ付加()

   Dim フォルダ As Object
   Dim ファイル As Object
   Dim ファイルシステムオブジェクト As Object
   Dim ファイル名 As String
   Dim ファイルパス As String
   Dim Excelバージョン As Integer

   'Excel のバージョンを取得:バージョンによって異なるコードを書くため
   Excelバージョン = Application.Version

   処理内容 = "Excel シートに値を付加"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   
   'ファイルシステム・オブジェクトを使って、フォルダ、ファイルを操作する
   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
   Set フォルダ = ファイルシステムオブジェクト.GetFolder(ThisWorkbook.Path)
   
   '★Excelの存在するフォルダの全てのファイルを対象
   For Each ファイル In フォルダ.Files
   
      ファイル名 = ファイル.Name
      'このVBAのブック自身は、置換の対象外とする
      If ファイル名 <> ThisWorkbook.Name Then
         ファイルパス = ファイル.Path
         'ファイルの拡張子を調べて、Excelブックのみを、置換対象とする
         If LCase(Mid(ファイル名, InStrRev(ファイル名, ".") + 1, 3)) = "xls" Then
                     
            'Excelブックを開く
            Workbooks.Open Filename:=ファイルパス
         
            ' 指定ブックのすべてのシートの品番について、品目分類コードを、For〜Nextで付加します。
            For Each 対象シート In Worksheets
               対象シート.Activate
                 
               最終行 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
               For 処理行 = 3 To 最終行
                  If Range("A1").Cells(処理行, 1).Value <> "" _
                  And Range("G1").Cells(処理行, 1).Value = "" Then  '更新対象の品目番号
                  
                     品番 = Range("A1").Cells(処理行, 1).Value
                     If 品番索引.Exists(品番) = True Then
                        Range("G1").Cells(処理行, 1).Value = データ配列(品番索引(品番))
                     Else
                        Range("G1").Cells(処理行, 1).Value = "マスタ不在"
                     End If
                  End If
               Next 処理行
            Next

            'いずれかのシートで、置換をした場合
            
            'Excel 2007〜の場合
            If Excelバージョン > 11 Then
               '[互換性チェック] ダイアログで、機能を無効にする
               '[このブックを保存するときに互換性を確認する] を外す
               ActiveWorkbook.CheckCompatibility = False
            End If
            ActiveWorkbook.Close True 'ブックの変更を保存して閉じる。

         End If '全てのExcelブック
      End If 'このブック以外
   Next ファイル '全てのファイル

   'オブジェクトを解放する
   Set フォルダ = Nothing
   Set ファイルシステムオブジェクト = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る

ホームページのトップに戻る