Excel VBA 他のプログラムとの連係
VBAで他のプログラムを動かす(起動・終了)
下記サイトに詳述されています。
API関数(ShellExecute)
パソコン活用研究5番街(Visual Basic、Excel(VBA)、BASIC プログラミング研究)
http://homepage2.nifty.com/kasayan/vba/vba4.htm
Shell関数
パソコン活用研究5番街(Visual Basic、Excel(VBA)、BASIC プログラミング研究)
http://homepage2.nifty.com/kasayan/vba/vba3.htm
[VB] Win32 アプリケーションを起動させ、終了させる方法
http://support.microsoft.com/kb/129797/ja
VBから起動したプログラムを終了させる(API)
http://www.geocities.co.jp/SiliconValley/4805/vbtips/vbtips100.htm
VB テクニック編2 - Windows API、ウィンドウハンドル取得、ウィンドウ制御
http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t02.htm
例えば、マクロで、マウス操作部分を、BearMouse を使って自動化させたい場合は、下記のように書きます。
Windows OS のバージョンによって、BrMousNT.exe のパスが変わっているので、下記は、パスの存在をチェックして、起動させるパスを決めています。
Sub ベアマウス起動()
Dim ベアマウス起動 As Variant
Dim ファイルシステムオブジェクト As Object
Dim ファイルパス1 As String
Dim ファイルパス2 As String
Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")
ファイルパス1 = "C:\Program Files\BearSofts\BrMouse\BrMousNT.exe "
ファイルパス2 = "C:\tool\BearMouse\BrMousNT.exe "
If ファイルシステムオブジェクト.FileExists (ファイルパス1) = True Then
ベアマウス起動 = Shell(ファイルパス1)
ElseIf ファイルシステムオブジェクト.FileExists (ファイルパス2) = True Then
ベアマウス起動 = Shell(ファイルパス2)
Else
MsgBox "BrMousNT.exe のパスは、下記のいずれかにして下さい。" & vbNewLine _
& "C:\Program Files\BearSofts\BrMouse\BrMousNT.exe" & vbNewLine _
& "C:\tool\BearMouse\BrMousNT.exe"
End If
Set ファイルシステムオブジェクト = Nothing
End Sub
Sub ベアマウス終了()
Dim TaskClean起動 As Variant
TaskClean起動 = Shell("C:\tool\TaskClean\TaskClean.exe -pc BrMousNT.exe")
End Sub
解説:
BearMouse は、ウインドウを持たないため、TaskClean を使って終了させています。
Excel ブックを閉じるときに自動実行させる方法は、ブックを閉じる時に実行(イベント) を参照下さい。
Shell 関数
実行可能プログラムを実行し、実行が完了するとプログラムのタスク ID を示すバリアント型 (内部処理形式 Double の Variant) の値を返します。プログラムの実行に問題が発生した場合は、0 を返します。
構文 Shell(pathname [,windowstyle ])
Shell 関数は、次の名前付き引数 から構成されます。
指定項目
内容
pathname
必ず指定します。バリアント型 (内部処理形式 String の Variant) の値を指定します。実行するプログラム名と必要な引数名またはコマンド ラインのスイッチを指定します。また、フォルダ、またはドライブを含めて指定できます。Macintosh では、MacID 関数を使ってアプリケーションの名前の代わりにシグネチャを指定できます。次の例は、Microsoft Word のシグネチャを使用したものです。
S
hell MacID("MSWD")
windowstyle
省略可能です。実行するプログラムのウィンドウの形式に対応するバリアント型 (内部処理形式 Integer の Variant) の値を指定します。引数 windowstyle を省略すると、プログラムはフォーカスを持った状態で最小化され、実行を開始します。Macintosh (System 7.0 以降) では、windowstyle は、アプリケーションの実行中に、そのアプリケーションがフォーカスを取得できるかどうかを指定するだけです。
名前付き引数 windowstyle には、次の値を指定します。
定数
値
内容
vbHide
0
フォーカスを持ち、非表示にされるウィンドウ。定数 vbHide は、Macintosh では使用できません。
vbNormalFocus
1
フォーカスを持ち、元のサイズと位置に復元されるウィンドウ
vbMinimizedFocus
2
フォーカスを持ち、最小化表示されるウィンドウ
vbMaximizedFocus
3
フォーカスを持ち、最大化表示されるウィンドウ
vbNormalNoFocus
4
最後にウィンドウを閉じたときのサイズと位置に復元されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。
vbMinimizedNoFocus
6
最小化表示されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。
解説
指定したプログラムが問題なく実行できると、プログラムのタスク ID が返されます。タスク ID は、実行中のプログラムを識別する重複しない番号です。指定されたプログラムが実行できないと、エラーが発生します。Microsoft Windows 上で、
MacID 関数を使用するとエラーが発生します。
メモ
既定の設定では、Shell 関数はプログラムを非同期的に実行します。したがって、Shell 関数を使用して実行を開始したプログラムが終了しなくても、Shell 関数の次のステートメントは実行されます。
DDE (Dynamic Data Exchange)
ExcelVBAでWord(.doc)ファイルを操作する(1)(ケンちゃんの世界 )
http://members.at.infoseek.co.jp/kenchan_h/Index20.html
Tcl/TkでDDE?
http://www.geocities.co.jp/SiliconValley/4137/dir1/ddee1.html
OLE (Object Linking and Embedding)
OLEオートメーションに対応しているソフト(Excel、Word、Access、一太郎 etc.)に限定される。
ExcelVBAでWord(.doc)ファイルを操作する(2)(ケンちゃんの世界 )
http://members.at.infoseek.co.jp/kenchan_h/index21.html
Set objShell = CreateObject("Wscript.Shell")
objShell.Run(ファイル名)
上は、汎用的なファイル オープン スクリプトです。
CreateObject("Wscript.Shell") で、Windows Script Hostのオブジェクトを作っています。
http://www.microsoft.com/japan/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx
ファイル名が、URLの場合は、WSH Shell オブジェクトのインスタンスを作成し、Run メソッドを使用して既定の Web ブラウザを開き、指定された URL にアクセスします。
ファイル名に C:\Scripts\ScriptLog.txt のようなファイル パスがある場合、このスクリプトを実行すると、このファイルがメモ帳 (または .txt ファイルに関連付けられた他のアプリケーション) で開きます。
ファイル名に .doc ファイルのパスがある場合は、このスクリプトを実行することにより、そのドキュメントが Microsoft Word で開きます。
WMI Fun !!
http://www.wmifun.net/
アプリケーションを終了する
http://www.wmifun.net/sample/win32_processc.html
Win32_ProcessクラスのTerminateメソッドを使用します。
VBレスキュー(花ちゃん)
http://hanatyan.sakura.ne.jp/
他のプログラムの終了を待つには
http://hanatyan.sakura.ne.jp/vbhlp/tap_PrgEnd.htm
API 技術関連
http://homepage1.nifty.com/MADIA/vb/VBKANREN.htm
140.アプリケーション(ウインドウ)の強制終了方法
http://homepage1.nifty.com/MADIA/vb/API/AppWinExit.htm
以下は、nda23 さんの VBA質問掲示板2009/09/07書き込みから転載させていただきました。
http://www.happy2-island.com/bbs/bbs.cgi
'通常の×ボタンで画面を閉じるときの流れ:
'FindWindowで該当ウィンドウを調べ、
'それにSendMessageを使ってWM_CLOSEメッセージを送り込みます。
Declare Function FindWindowA& Lib "USER32" (ByVal C&, ByVal T$)
Declare Function SendMessageA& Lib "USER32" _
(ByVal H&, ByVal M&, ByVal W&, ByVal L&)
Const WM_CLOSE = &H10
Sub ウインドウ終了()
Dim H&
' H = FindWindowA(0, "電卓") '← 画面のタイトルバーの文字列(電卓の場合)
H = FindWindowA(0, "(無題) - sakura 1.6.3.0 ") '← 画面のタイトルバーの文字列(sakuraエディタの場合)
If H <> 0 Then SendMessageA H, WM_CLOSE, 0, 0
End Sub
ExcelのVBAで、Accessのデータを参照・更新する
ExcelのVBAを使って、Accessのデータベースを参照・更新するときは、ADO(ActiveX Data Objects) を使います。
事例は、Access データベースをシーケンシャルに更新する の項も、参照下さい。
下記のサイトを、参考にさせていただきました。感謝!!
畑本賢治(ケンちゃんの世界)さんの、
・ExcelVBAでAccessデータを操作する(3) 〜 ADO基礎編 〜
http://members.at.infoseek.co.jp/kenchan_h/index18.html
infoseek のサービス停止に伴って、消えていました。(-_-;)
文字部分だけ は、インターネット保管庫 で見つけました。
・ExcelVBAでAccessデータを操作する(4) 〜 ADO応用編 〜
http://members.at.infoseek.co.jp/kenchan_h/index19.html
文字部分だけ は、インターネット保管庫 で見つけました。
結城圭介(Happy!Happy!Island) さんの、
「VBS(WSH)事例集」
http://www.happy2-island.com/vbs/cafe01/
http://www.happy2-island.com/vbs/cafe02/
6.2 AccessのDBを開く・閉じる
http://www.happy2-island.com/access/gogo03/capter00602.shtml
5.6 SQLの実行/SELECT
http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
6.5 SQLの実行/INSERT、UPDATE系
http://www.happy2-island.com/vbs/cafe02/capter00605.shtml
cbc(基礎から始めるAccess_VBA講座) さんの
Recordsetオブジェクトの作成(ADO編)
http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
ポイント:ADOでレコードセットを作るとき、レコードの更新、変更、削除ができるように、RecordsetオブジェクトのOpenメソッドを使います。
Excelでデータベース操作(Accessと連携)
http://antonsan.net/study/excel/cont_excel.php
Excel講座 > ExcelからAccessデータを利用する
http://www.serpress.co.jp/excel/vba038.html
Access2000のRecordsetの使い方
http://www.ne.jp/asahi/hishidama/home/tech/access/recset.html
Access のデータを検索して、Excelに取り込む(Accessオブジェクト利用)
下の例は、 Access のデータベースで持っている、「自社品目番号と客先品目番号の対比表(X-Ref)」を、マクロで、Excelのセルに登録してある「自社品目番号」を検索して、対応する「客先品目番号」を、Excelの右側のセルに書き出すものです。
結城圭介(Happy!Happy!Island) さんの、
5.6 SQLの実行/SELECT
http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
が、ほとんどそのまま使えました。
追記:
Access のデータを使って、Excelのセルに貼り込む(連想配列を使う) も参照下さい。
Option Explicit
Dim objAccess
Dim objDB
Dim objRS
Dim i
Dim 自社品目番号 As String
Dim 客先品目番号 As String
Dim クエリ As String
Dim 行 As Integer
Sub Access検索()
ThisWorkbook.Worksheets("Sheet1").Activate
'Accessオブジェクトを作成します
Set objAccess = CreateObject("Access.Application")
'Access画面を表示します
objAccess.Visible = True
'既存のMDBファイルを開きます
objAccess.OpenCurrentDatabase ("D:\原単位\品目番号X-Ref.mdb")
'DBオブジェクトを作ります
Set objDB = objAccess.CurrentDb
行 = 0
Do
行 = 行 + 1
自社品目番号 = Range("A2").Cells(行, 1).Value
If 自社品目番号 = "" Then
Exit Do
End If
If Left(自社品目番号, 1) = "'" Then
自社品目番号 = Right(自社品目番号, Len(自社品目番号) - 1)
End If
クエリ = "select 客先番号 from 200812時点 WHERE 自社番号 = " & Chr(34) & 自社品目番号 & Chr(34)
'@SQLを実行します
Set objRS = objDB.OpenRecordset(クエリ )
'ASQLの実行結果をデータが無くなるまで表示します
Do Until objRS.EOF = True
'Bフィールド値の表示
客先品目番号 = objRS("客先番号")
Range("B2").Cells(行, 1).Value = 客先品目番号
'Cカーソルを次の行へ
objRS.MoveNext
Loop
Loop
'Dレコードセットをクローズします
objRS.Close
'データベースをクローズします
objDB.Close
'MDBファイルを閉じます
objAccess.CloseCurrentDatabase
'@Accesを終了します
objAccess.Quit
'各種オブジェクトの破棄
Set objRS = Nothing
Set objDB = Nothing
Set objAccess = Nothing
End Sub
Access Jet Engine のバージョンを調べる
Access Jet Engine (データベース)のバージョンを知りたいので作ってみました。
Sub JETエンジンバージョン取得()
Dim objAccess
Dim objDB
'Accessオブジェクトを作成します
Set objAccess = CreateObject("Access.Application")
'Access画面を表示します
objAccess.Visible = True
'既存のMDBファイルを開きます
objAccess.OpenCurrentDatabase ("D:\既存Access.mdb")
'DBオブジェクトを作ります
Set objDB = objAccess.CurrentDb
MsgBox objDB.Version
'データベースをクローズします
objDB.Close
'MDBファイルを閉じます
objAccess.CloseCurrentDatabase
'各種オブジェクトの破棄
Set objDB = Nothing
Set objAccess = Nothing
End Sub
Access データベースをシーケンシャルに更新する(ADO接続)
(Excel の Ranking 関数のように順位を算出する)
この例は、Excel マクロで、Accessのテーブルの項目の属性の値について、ランキング(順位付け)をして、Accessのテーブルを更新するものです。
Accessのマクロや、SQL を使って、ランキングを表示する方法は、下記に詳しく書かれています。
http://www.moug.net/tech/acvba/0120012.htm
ここでは、Excel マクロで、テーブルのデータを抜き出して、ソートして、順位を設定して、結果をテーブルに書き込んでいます。Excel から操作するため、既存の、どのAccessのデータベースでも対象にできる点が、特長です。
ただし、ランダム書き込みは時間がかかるので、Accessのテーブルを、前もって、Accessで、キーの昇順に並び替えておく必要が有ります。この前提で、私のパソコンで、30万件のデータのテーブルを、30秒で順位書き込みできたので、それなりに役に立つでしょう。
ADO を使うためには、参照設定を追加する必要が有ります。
VBE の、[ツール(T)]→[参照設定(R)]を選択します。
表示される、参照設定用のダイアログボックスで、
「Microsoft ActiveX Data Objects *.* Library」にチェックを入れて、[OK]ボタンを押します。
(注)"*.*"のところは、ADOのバージョンです。新しいものにすると、古いバージョンの Office では動かなくなるので、2.6 あたりを選択すると良いでしょう。
'==============================================
'配列の初期値を1にする
'==============================================
Option Base 1
Dim 開始日時 As Variant
Dim 終了日時 As Variant
Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim Accessテーブル As ADODB.Recordset
Dim 選択SQL As String
Dim AccessDB名 As String
Dim Accessテーブル名 As String
Dim キー項目名 As String
Dim 評価項目名 As String
Dim 順位設定項目名 As String
Dim 順方向 As Integer
Dim データ量 As Long
Dim 配列() As Variant
Dim 現在のパス As String
Dim 処理内容 As String
Dim データ件数 As Long
Dim 処理行 As Long
Dim カウンタ As Long
Dim 順位 As Long
Dim 直前順位 As Long
Dim 一時変数 As Variant
Dim 直前値 As Variant
'==============================================
Sub 順位設定()
'==============================================
開始日時 = Now
'処理の前提のパラメータを設定
現在のパス = ThisWorkbook.Path
ThisWorkbook.Worksheets("Sheet1").Activate
AccessDB名 = Range("B11").value
Accessテーブル名 = Range("B12").value
キー項目名 = Range("B13").value
評価項目名 = Range("B14").value
順位設定項目名 = Range("B15").value
順方向 = Range("B16").value
データ量 = Range("B17").value
ReDim 配列(データ量, 3)
Call テーブル読み込み
処理内容 = "評価項目でソート"
Application.StatusBar = "★☆★" & 処理内容 & "★☆★"
Call クイックソート2次元配列 (配列, 1, データ件数)
Call 順位カウント
'配列の左端を、比較項目から、キー項目に入れ替える
Call 列入れ替え
処理内容 = "キー項目でソート"
Application.StatusBar = "★☆★" & 処理内容 & "★☆★"
Call クイックソート2次元配列 (配列, 1, データ件数)
Call テーブルに書き込み
終了日時 = Now
MsgBox "処理時間は、" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
End Sub
'==============================================
Private Sub テーブルに書き込み()
'==============================================
処理内容 = "Accessのテーブルに書き込み"
Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
データ件数 = 0
'★Accessのデータベースに接続して、テーブルをシーケンシャルに検索して更新
'http://members.at.infoseek.co.jp/kenchan_h/index18.html
'New キーワードを使用して新規Connectionオブジェクトを生成
Set 接続 = New ADODB.Connection
'接続先のデータベース
ファイル名 = 現在のパス & "\" & AccessDB名
'接続
接続.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & ファイル名
'レコードセットの作成(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
データ件数 = データ件数 + 1
'Accessテーブルの、特定フィールドの値を所得します
'MS ACCESS 95/97 の美しいソート順:Accessのソートと教科書のソートの違いを吸収
'http://www.massangeana.com/mas/comp/acccoll.htm#hyphen
If 配列(データ件数, 1) <> Replace (Accessテーブル(キー項目名), "-", "") Then
MsgBox "キーが一致しません!"
Stop
End If
'フィールドの値を変更
Accessテーブル.Update 順位設定項目名, 配列(データ件数, 3)
'レコードの順読み
Accessテーブル.MoveNext
Loop
'レコードセットのクローズ
Accessテーブル.Close
'接続を解除
接続.Close
'オブジェクトをクリア
Set Accessテーブル = Nothing
Set 接続 = Nothing
End Sub
'==============================================
Private Sub 列入れ替え()
'==============================================
For 処理行 = 1 To データ件数
一時変数 = 配列(処理行, 1)
配列(処理行, 1) = 配列(処理行, 2)
配列(処理行, 2) = 一時変数
Next 処理行
End Sub
'==============================================
Private Sub 順位カウント()
'==============================================
処理内容 = "順位設定"
Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
カウンタ = 0
If 順方向 = 2 Then '昇順
For 処理行 = 1 To データ件数
カウンタ = カウンタ + 1
If 配列(処理行, 1) = 直前値 Then
順位 = 直前順位
Else
直前値 = 配列(処理行, 1)
順位 = カウンタ
End If
配列(処理行, 3) = 順位
直前順位 = 順位
Next 処理行
Else '降順
For 処理行 = データ件数 To 1 Step -1
カウンタ = カウンタ + 1
If 配列(処理行, 1) = 直前値 Then
順位 = 直前順位
Else
直前値 = 配列(処理行, 1)
順位 = カウンタ
End If
配列(処理行, 3) = 順位
直前順位 = 順位
Next 処理行
End If
End Sub
'==============================================
Private Sub テーブル読み込み()
'==============================================
処理内容 = "Accessのテーブルを読み込み"
Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
データ件数 = 0
'★Accessのデータベースに接続して、テーブルをシーケンシャルに取得
'New キーワードを使用して新規Connectionオブジェクトを生成
Set 接続 = New ADODB.Connection
'接続先のデータベース
ファイル名 = 現在のパス & "\" & AccessDB名
'接続
接続.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & ファイル名
'レコードセットの作成(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
データ件数 = データ件数 + 1
'Accessテーブルの、特定フィールドの値を配列に格納します
'MS ACCESS 95/97 の美しいソート順:Accessのソートと教科書のソートの違いを吸収
'http://www.massangeana.com/mas/comp/acccoll.htm#hyphen
配列(データ件数, 2) = Replace (Accessテーブル(キー項目名), "-", "")
配列(データ件数, 1) = Accessテーブル(評価項目名)
配列(データ件数, 3) = Accessテーブル(順位設定項目名)
'レコードの順読み
Accessテーブル.MoveNext
Loop
'レコードセットのクローズ
Accessテーブル.Close
'接続を解除
接続.Close
'オブジェクトをクリア
Set Accessテーブル = Nothing
Set 接続 = Nothing
End Sub
「実行時エラー ’3131′: FROM句の構文エラーです。」が表示されたら
http://chiroinu.freehostia.com/wordpress/?p=310
みるくP ブログ で、下記のノウハウを公開していただいていました。
ExcelVBAにてCSVファイルをテーブルとして接続する際、エラーが発生してしまう場合があります。
下記にご注意!
@ファイル名に禁則文字が使われている場合[-ハイフンやスペース等]
Aファイル名のトータルが拡張子を含み59文字を超える場合。(XP、OFFICE2003のみで実験)
@はテーブル名を[]で囲えば解決します。お気をつけを・・・
⇒SELECT * FROM [悪い テーブル - 名.csv]
以下は、順位を設定するために、並び替えをする部分です。
下記で公開していただいている、「再帰呼び出ししないクイックソート」を使わせていただきました。
システムエンジニアの戯言 →再帰呼び出ししないクイックソート
http://ameblo.jp/blueskyame/entry-10244296193.html
「再帰呼び出ししないクイックソートは、再帰呼び出しする方式と比べて高速な動作が期待できます。(関数呼び出しによるオーバーヘッドがなくなるので。)」とのことです。
コードを使うにあたって、下記を参考にしました。
Excel VBAではじめるクラス入門
http://codezine.jp/article/detail/499
また、下記で公開していただいている、「2次元配列のデータをソートする関数」を使わせていただきました。
K-yamadaの日記 →2次元配列のデータをソートする関数
http://d.hatena.ne.jp/K-yamada/mobile?word=*%5BExcel%20VBA%5D
上を参考にして、「スタックデータを表現するクラスモジュール 」の定義を登録します。
'==============================================
'配列の初期値を1にする
'==============================================
Option Base 1
'========================================
'2次元配列をクイックソートする。
'一番左の列がソートのキー項目になる。
'========================================
Public Sub クイックソート2次元配列(ByRef 対象配列 As Variant, ByVal 配列要素下限 As Long, ByVal 配列要素上限 As Long)
Dim 左 As Long
Dim 右 As Long
左 = 配列要素下限
右 = 配列要素上限
' スタックオブジェクト
Dim スタックオブジェクト As New ValStack
' スタックに格納する値
' (対象配列を走査する情報、左端と右端のインデックスを格納する)
Dim スタックに格納する値 As Variant
' 対象配列変数を生成する
ReDim スタックに格納する値(1 To 2)
' ベースとなる値
Dim 基準値 As Variant
' 中心のインデックス
Dim 中心のインデックス As Long
Dim i As Long
Dim j As Long
' スタックに最初に設定する変数を設定
スタックに格納する値(1) = 左
スタックに格納する値(2) = 右
' スタックにプッシュする
スタックオブジェクト.push スタックに格納する値
' スタックの中身がなくなるまで実行
Do While スタックオブジェクト.count > 0
' スタックから値を取り出す
スタックに格納する値 = スタックオブジェクト.pop
' 左端を取得
左 = スタックに格納する値(1)
' 右端を取得
右 = スタックに格納する値(2)
' ここからクイックソートのアルゴリズム(教科書どおり)
If 左 < 右 Then
中心のインデックス = Int((左 + 右) / 2)
基準値 = 対象配列(中心のインデックス, 1)
i = 左
j = 右
Do While i <= j
Do While 対象配列(i, 1) < 基準値
i = i + 1
Loop
Do While 対象配列(j, 1) > 基準値
j = j - 1
Loop
If i <= j Then
'1行分のデータを入れ替える
Call 行入れ替え (対象配列, i, j)
i = i + 1
j = j - 1
End If
Loop
'基準値の左に2以上要素があれば、左の対象配列をソートする
If 左 < (i - 1) Then
スタックに格納する値(1) = 左
スタックに格納する値(2) = i - 1
スタックオブジェクト.push スタックに格納する値
End If
'基準値の右に2以上要素があれば、右の対象配列をソートする
If (j + 1) < 右 Then
スタックに格納する値(1) = i
スタックに格納する値(2) = 右
スタックオブジェクト.push スタックに格納する値
End If
End If
Loop
End Sub
'============================================================
'2次元対象配列の1行分のデータを入れ替える
'============================================================
Sub 行入れ替え(処理配列 As Variant, ByVal i As Long, ByVal j As Long)
Dim 最大列 As Long
Dim 列 As Long
Dim バッファ As Variant
最大列 = UBound (処理配列, 2)
For 列 = 1 To 最大列
バッファ = 処理配列(i, 列)
処理配列(i, 列) = 処理配列(j, 列)
処理配列(j, 列) = バッファ
Next
End Sub
参考:
2次元配列の並べ替え(バブルソート,クイックソート)
https://excel-ubara.com/excelvba5/EXCELVBA229.html
Excel VBA で Access のデータベースを最適化/修復
Access のデータベース(.mdb)は、ファイル・サイズが 2GB という制約が有ります。このため、クエリを実行していてファイル・サイズが 2GB を超えると、クエリが失敗します。
これを防止するため、適当なところで、Excel VBA で、Accessデータベースを最適化/修復して、ファイル・サイズを圧縮するものです。
この例では、10万件クエリ処理する毎に、いったんデータベースを閉じて、最適化/修復処理をしています。
このマクロの全体は、ある会社の品目番号を、英数だけのものから、ハイフンを挿入した見やすい体系に変換するものです。
身近な例に置き換えると、電話番号が有ります。電話番号は数字の羅列です。しかし数字だけで表示すると、視認性が悪いので、通常は、括弧やハイフンを付けて表示します。
電話番号で言えば、数字の羅列から、局番号やキャリアーなどを辞書引きして、適切にハイフンを挿入するプログラムと考えていただければ、分かると思います。
Option Explicit
Option Base 1
Dim 開始日時 As Variant
Dim 終了日時 As Variant
Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim Accessテーブル As ADODB.Recordset
Dim 選択SQL As String
Dim AccessDB名 As String
Dim Accessテーブル名 As String
Dim 現在のパス As String
Dim ハイフン無品番項目 As String
Dim ハイフン有品番項目 As String
Dim 品番パターン項目 As String
Dim 設定パターン項目 As String
Dim ハイフン無 As String
Dim ハイフン有 As String
Dim 正規表現オブジェクト As Object
Dim 品番パターン辞書() As Variant
Dim 品番パターン件数 As Integer
Dim ハイフンパターン As String
Dim ハイフン設定辞書() As Variant
Dim ハイフンパターン件数 As Integer
Dim 検索位置 As Integer
Dim 処理行 As Integer
Dim ハイフンパターン索引 As Object 'Scripting.Dictionary オブジェクト
Dim ハイフンパターン配列添え字 As Integer 'Scripting.Dictionary オブジェクトのデータ
Dim パターン行 As Integer
Dim カウンタ As Long
Dim 全体カウンタ As Long
Dim 最終 As String
Dim strDstMDB As String
Dim jro As jro.JetEngine
Sub ADO接続でAccessテーブルを更新()
開始日時 = Now
'処理の前提のパラメータを設定
現在のパス = ThisWorkbook.Path
Set 正規表現オブジェクト = New RegExp
'★辞書データの読み込み
ThisWorkbook.Worksheets("品番パターン辞書").Activate
品番パターン件数 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
品番パターン辞書 = Range("A1").Resize(品番パターン件数, 3) '処理速度をあげるため、辞書部分は配列(メモリ)に登録。
ThisWorkbook.Worksheets("ハイフン設定辞書").Activate
ハイフンパターン件数 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
ハイフン設定辞書 = Range("A1").Resize(ハイフンパターン件数, 3) '処理速度をあげるため、辞書部分は配列(メモリ)に登録。
'★ハイフンパターン索引を作成★
Set ハイフンパターン索引 = CreateObject("Scripting.Dictionary") '★連想配列の定義
For 処理行 = 1 To ハイフンパターン件数
ハイフンパターン = ハイフン設定辞書(処理行, 1) 'ハイフンパターン
ハイフンパターン索引(ハイフンパターン) = 処理行
Next 処理行
'更新対象を取得
ThisWorkbook.Worksheets("Access更新").Activate
AccessDB名 = Range("B11").Value
Accessテーブル名 = Range("B12").Value
ハイフン無品番項目 = Range("B14").Value
ハイフン有品番項目 = Range("B15").Value
品番パターン項目 = Range("B16").Value
設定パターン項目 = Range("B17").Value
最終 = ""
Do While 最終 = ""
'★Accessのデータベースに接続して、テーブルをシーケンシャルに検索して更新
'http://members.at.infoseek.co.jp/kenchan_h/index18.html
'New キーワードを使用して新規Connectionオブジェクトを生成
Set 接続 = New ADODB.Connection
'接続先のデータベース
ファイル名 = 現在のパス & "\" & AccessDB名
'接続
接続.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & ファイル名
'レコードセットの作成(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
'最終レコードまで順読み込みを行う
カウンタ = 0
全体カウンタ = 0
Do Until Accessテーブル.EOF = True
全体カウンタ = 全体カウンタ + 1
If カウンタ > 100000 Then Exit Do ' Access DB が2Gを超えないように
'Accessテーブルの、特定フィールドの値を取得します
ハイフン無 = Accessテーブル(ハイフン無品番項目)
If IsNull(Accessテーブル(ハイフン有品番項目)) = True Then
'マクロを使ってハイフン設定
'正規表現を使って、ワイルドカード照合して、ハイフンパターンを知る
For パターン行 = 1 To 品番パターン件数
正規表現オブジェクト.Pattern = 品番パターン辞書(パターン行, 1)
正規表現オブジェクト.IgnoreCase = False
'大文字小文字を区分する。デフォルトは、True(区別しない)
If 正規表現オブジェクト.Test(Left(ハイフン無, 10)) = True Then '正規表現を使って、ワイルドカード検索。
ハイフン有 = _
ReplaceRegExpr(CStr(ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 2)), Left(ハイフン無, 10), CStr(ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 3))) _
& Right(ハイフン無, Len(ハイフン無) - 10)
'フィールドの値を変更
Accessテーブル.Update ハイフン有品番項目, ハイフン有
Accessテーブル.Update 品番パターン項目, ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 1)
Accessテーブル.Update 設定パターン項目, 品番パターン辞書(パターン行, 3)
カウンタ = カウンタ + 1
Exit For
End If
Next パターン行
End If
'レコードの順読み
Accessテーブル.MoveNext
Loop
If Accessテーブル.EOF = True Then 最終 = "最終"
'レコードセットのクローズ
Accessテーブル.Close
'接続を解除
接続.Close
'オブジェクトをクリア
Set Accessテーブル = Nothing
Set 接続 = Nothing
'データベースを圧縮
Set jro = New jro.JetEngine
' VBAを使ってデータベースを修復/最適化
' http://www.tsware.jp/study/vol1/kaibo_09.htm
' ADO から Microsoft Access データベースを最適化するには、方法
' http://support.microsoft.com/kb/230501/ja
'最適化先の一時MDBファイルのフルパスを設定
strDstMDB = 現在のパス & "\" & "~tmp" & AccessDB名
'最適化の実行
jro.CompactDatabase _
"Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ファイル名 _
, "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDstMDB
'最適化元のファイルを削除
Kill ファイル名
'最適化先のファイル名を最適化元のファイル名にリネーム
Name strDstMDB As ファイル名
Set jro = Nothing
Loop
Set 正規表現オブジェクト = Nothing
ThisWorkbook.Worksheets("Access更新").Activate
Range("B21").Value = 全体カウンタ
終了日時 = Now
MsgBox "処理時間は、" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
End Sub
dBASE データベースをシーケンシャルに参照する(ADO接続)
接続先のデータベースとして、Access ではなく、dBASE の .dbf に接続して、データベースの内容を VBA で読みとる場合のコード例を紹介します。
dBASE とは→http://ja.wikipedia.org/wiki/DBASE
dBASE に接続する場合は、パスとテーブルの指定区分が Access とは異なる点に、注意が必要です。
← ファイル・パス → ←テーブル名 →
フォルダパス\AccessDB名.mdb Accessテーブル名
フォルダ・パス \dBASEのDB名 .dbf
← ファイル・パス → ←テーブル名→
dBASE では、ファイル・パスに「フォルダ・パス」を指定します。テーブル名に「ファイル名(拡張子なし)」を、指定します。
データベースでは、項目が空白の場合に、Null値が入っていることがあります。VBA の変数で、Null値を受け取ることができるのは、Variant 変数のみです。このため、下の例では、ユーザ定義関数を使って、Null値を「空白」に変換して、String 変数に格納できるようにしています。
ADO を使うためには、参照設定を追加する必要が有ります。
VBE の、[ツール(T)]→[参照設定(R)]を選択します。
表示される、参照設定用のダイアログボックスで、
「Microsoft ActiveX Data Objects *.* Library」にチェックを入れて、[OK]ボタンを押します。
(注)"*.*"のところは、ADOのバージョンです。新しいものにすると、古いバージョンの Office では動かなくなるので、2.6 あたりを選択すると良いでしょう。
Option Explicit
Option Base 1
Dim 処理件数 As Integer
Dim 開始日時 As Variant
Dim 終了日時 As Variant
Dim カウンタ As Long
Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim ファイルのフォルダ As String
Dim dBASEテーブル As ADODB.Recordset
Dim 選択SQL As String
Dim テーブル名 As String
Dim 品番 As String
Dim 品名 As String
Sub ADO接続でdBASEのDBを読む()
'接続先のデータベース
ファイル名 = Application.GetOpenFilename ("dBASEのファイル,*.dbf")
If ファイル名 = "False" Then End
テーブル名 = Dir (ファイル名)
テーブル名 = Left(テーブル名, Len(テーブル名) - 3) '拡張子を除く
ファイルのフォルダ = Left(ファイル名, InStrRev (ファイル名, "\") - 1)
開始日時 = Now
'★dBASEのデータベースに接続して、テーブルをシーケンシャルに検索して更新
'New キーワードを使用して新規Connectionオブジェクトを生成
Set 接続 = New ADODB.Connection
'接続
接続.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ファイルのフォルダ & _
";Extended Properties=dBASE 5.0;"
'レコードセットの作成(SELECT文の実行)
Set dBASEテーブル = New ADODB.Recordset
選択SQL = "SELECT * FROM " & テーブル名
'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
'RecordsetオブジェクトのOpenメソッドを使います。
'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
'Recordsetオブジェクトの作成(ADO編)
dBASEテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
'最終レコードまで順読み込みを行う
'http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
カウンタ = 0
Do Until dBASEテーブル.EOF = True
カウンタ = カウンタ + 1
If カウンタ Mod 10000 = 0 Then
'dBASEテーブルの、特定フィールドの値を所得します
品番 = dBASEテーブル("HIN")
品名 = 文字列化(dBASEテーブル("Name"))
Application.StatusBar _
= CStr(カウンタ) & "件目 " & 品番 & " " & 品名
End If
'レコードの順読み
dBASEテーブル.MoveNext
Loop
Application.StatusBar _
= CStr(カウンタ) & "件目 " & 品番 & " " & 品名
'レコードセットのクローズ
dBASEテーブル.Close
'接続を解除
接続.Close
'オブジェクトをクリア
Set dBASEテーブル = Nothing
Set 接続 = Nothing
終了日時 = Now
MsgBox "処理時間は、" _
& Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"
End Sub
Function 文字列化(バリアント As Variant) As String
文字列化 = IIf(IsNull (バリアント) = True, "", バリアント)
End Function
解説:
dBASE に接続するための引数は、下記のサイトで教えていただきました。
http://www.mrexcel.com/forum/showthread.php?t=355455
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DBDirectory & _
";Extended Properties=DBASE IV;"
Set rs = New ADODB.Recordset
With rs
.Open "SELECT * FROM [MISS_T~3.dbf]", cn, , , adCmdText
下記で紹介されているコードでは、うまく接続できませんでした。
http://msdn.microsoft.com/ja-jp/library/dd148538.aspx
IsNull 関数 は、式に Null 値が含まれているかどうかを調べ、結果をブール型 (Boolean) で返します。
構文
IsNull( expression )
引数 expression は必ず指定します。引数 expression には、数式または文字列式を含むバリアント型 (Variant) の式を指定します。
IsNull 関数は、引数 expression の値が Null 値 である場合は、真 (True) を返します。それ以外は偽 (False) を返します。
引数 expression が複数の変数で構成されている場合、変数が 1 つでも Null 値 のときには式全体が Null 値 となり、真 (True) が返されます。
Null 値 は、バリアント型 (Variant) に有効なデータが入っていないことを示す値であり、変数が初期化されていないことを示す Empty 値や、Null 文字列と呼ばれる長さが 0 の文字列 ("") とは異なります。
IsNull 関数を使用すると、式に Null 値 が含まれているかどうかを調べることができます。
If Var = Null
や If Var <> Null
のように他の状況では真 (True) と評価される式でも、偽 (False) になります。これは、Null 値 を含む式はすべて式自体が Null 値 となり、偽 (False) と評価されるためです。
VBA で DOSコマンドを実行する
Shell関数を用いて DOS のコマンドを実行する方法
http://support.microsoft.com/kb/404917/JA/
DOS コマンドの実行結果を取得する方法
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetDosResult.html
VBAからDOSのコマンドを実行する方法
http://billyboy.blog81.fc2.com/blog-entry-77.html