2022年4月12日 / 最終更新日時 : 2025年1月3日 officeの杜 msoffice

Excel自動化ならばPythonよりもVBSを使いましょう

世にRPAが出てからというもの、Power Automate for DesktopやPythonでExcel自動化なんて記事が出回るようになりました。前者はシステム全体の自動化につながるものであるため、個人的には推奨しています（年間何百万もするRPAなど愚の骨頂です）。

しかし、PythonでExcel自動化は推奨しません。そもそも、Excelの自動化は以前よりVBAやVBSで出来ている事。それ以外も含めてならば話は別ですが、世に出てる記事の殆どは「VBSで出来ることをわざわざPythonでやらせてる」という無駄と無用な手段に他なりません。ちなみにVBSはシステムの操作も可能であるため、Seleniumでスクレイピングでもしない限りほぼ、現状PythonでExcel自動化は非推奨です。

今回はVBSでのExcel自動化の一片を記述してみたいと思います。

目次

概要

VBScriptの非推奨化

2023年10月10日、MicrosoftからVBScriptの非推奨化と将来的なWindowsからの機能削除が発表されました。長年に渡って利用されてきたVBScriptですが、これにてDeprecatedが発表されたことで様々な領域への影響が非常に大きいと思われます。VB構文で書けて、情シスでも自動化の１つの選択肢として使ってきたり、デスクトップ自動化でもCOM経由で操縦できるVBScriptは非常に便利でした。

しかし今回の発表によって本エントリーで紹介してるVBScriptでの操縦は将来的にはできなくなるであろうと考えられます。次項以降の内容も踏まえての大対策としては

となります。いずれにせよ公式ツールではないPythonは非推奨です（個人のライブラリに依存するものを事務作業自動化に使うのはオススメ出来ない）

※MicrosoftよりVBScriptの廃止ロードマップの一部が公開。2027年以降はデフォルトで無効化されるようです。それまでにPowerShellに移行するようにしましょう。

※無効化フェーズ3以降は、DLLレベルでOSから削除されるようなので、VBAなどでもWindows Scripting RuntimeやDictionaryなどが動作しなくなる可能性があります。

図：2027年までに対策をしておきましょう

Power Automate Desktopで学ぶRPAテクニック

Pythonで自動化の愚

まず、よくあるExcelのPytyonでの自動化が何故非推奨なのか？という事ですが、まずもって自動化の必要なシーンの多くは事務作業です。そのデスクワーク業務（経理や人事・給与計算等）に於いて、何故愚行であるのか？それを列挙してみようと思います。

  1. そもそも通常の企業では、事務方のPCへのPythonインストールは許可しない（VBSがあるのだから不要と判断）。
  2. 圧倒的な知見の多いVBA、VBSと比較して、PythonでのExcel操作は知見がそこまで十分とは言えない。
  3. Excelを操作出来ると言っても、残念ながら単体で出来るわけではなく、外部ライブラリに依存しています（これらの永続性等に影響される）
  4. 3.の個別のライブラリによって、記述内容が大きく変わるため、メンテナンス上の問題が生じる
  5. 基本的にPythonとライブラリによって出来る事は、読み書きと一部メソッドの実行だけ。実際に細かい要求に応えられていない。
  6. macOSでも使えるという利点をあげるサイトがありますが、ほぼ事務の現場でmacOSが採用されることは有りません。
  7. 処理速度がPythonのほうが高速とありますが、その速度を求めるだけのデータ量は事務の現場にはほぼ存在しません（そういった処理は基幹業務システムが担ってる）
  8. 何よりもクライアント毎にPython実行環境の構築が要求される（EXE化して配布は可能ですが、そういったタスクをつくり手に要求されます）
  9. 学習コストはVBA・VBSよりもPythonのほうが全然高いです。

Pythonの学習であったり、極めて大量の統計データの処理、基幹業務システムとの連携等が必要とするようなシーンがあるならともかく、一般的な事務の現場では、ほぼ以上の理由により、現場にPythonを導入して自動化しましょう、とはなりません。VBSは現在のWindowsには元から標準装備されているもので、環境構築など不要です。

※Node.jsでもExcel読み書きのライブラリはありますが、同じようなネタになっていない辺りが、最近のPython + Excelネタの実態と言えます。

VBAで他のアプリケーションを操作する

ライブラリを使って読み書きして嵌った事例

前述のお話はPythonでライブラリを使って書き込むという事例のお話ですが、自分もアプリケーションの自動化処理の１つのタスクとしてNode.js + xlsx-populateで読み書きを実装するシーンがあります。読み取り分にはなんら問題ないですし、書込みも一見すると問題なく書き込めているので便利なライブラリなのですが、1例致命的な事例がありました。

書き込みしたファイルは壊れているわけでもなければ、見た目も問題ないのですが、このファイルをPower Queryの外部ソースとして呼び出して利用しようと思うと「DataFormat.Error」と出て、Binaryという文字列が表示されているエラーに遭遇しました。問題点を徐々に絞り込んだら、xlsx-populateで書き込んだ時点でエラーが出ており、xlsxファイルに何らかの潜在的な問題（互換性の問題）が生じてるようです。

自分の場合日付でもなんでもない、GUIDと作業中という文字を書き込んでるだけにも関わらず発生しており、一度手動で開いて何か記述して上書き保存すると読み込めるようになりましたが、Power Queryで使う予定のあるものを、外部のライブラリで読み書きするとこういった事例にぶつかる事もあることを頭に入れて置かなければなりません（公式のライブラリでもなんでもないわけで、この問題の絞り込みも相当な時間を消費しています）

故に、現在書込みについてだけは、xlsx-populateのようなライブラリではなくVBScriptでExcelを操作して書き込ませています。こういったポイントがPythonのExcel操作ライブラリに無いとは言い切れないですし、将来発生してもユーザはなかなかこれに気が付けないでしょう。

※すでにxlsx-populateはメンテされていないようで、新たにxlsm形式にデータを書き込むとExcelファイルが破損する現象も確認。Node.jsであれPythonであれ、そのライブラリが使い続けられるわけじゃないので、開発者が常に意識を配っていないと、このように嵌まります。

図：このようにファイルが破損することがあります。

基本的な知見はVBAと変わらない

VBSに関する知見はほとんどVBAと変わりません。VBAと異なる点としては

  1. ExcelやWordなどの実行するための土台を必要としておらず、単体で実行可能（Officeの入っていないマシンでも実行可能）
  2. コマンドラインから引数を渡して実行させる事が可能（情シスが起動時の自動処理でよく利用してる）
  3. Excel VBAと同じメソッドやコマンドを利用する事が可能である
  4. SAP GUI Scripting等の自動化機能でも利用されている

その為、コードの書き方についても殆ど同様に記述が可能であり、VBAを学んでいるものならば、既にもう使いこなせるものです。これを無視してPythonという話にはならないわけです。そしてそのケースはほぼアリません。

※但し一部でオプションの指定方法が異なるメソッドがあり、完全に同じというわけではありません。

SAP GUI Scriptingで自動操縦してみた

実行時の注意点

VBSファイル実行時の注意点ですが、vbsファイルの文字コードがUTF8の場合、中に書かれてる日本語が文字化けし、例えばそれがフルパスなどの場合だった時、正しいパスとして認識されずエラーになります。そのため、VBSファイルを作成する場合は基本的には、Shift-JISの形式で保存するようにしましょう。メモ帳で文字コードを変換して保存する場合の手順は以下の通りです。

  1. メモ帳を開いて、対象のVBSファイルを読み込ませる
  2. 名前をつけて保存を実行
  3. 文字コードをANSIに変更して保存する

これで、文字化けせずに実行する事が可能です。

図：ANSIに変更しておくのが定石

タスクスケジューラで定期自動実行

VBAの入ったExcelファイルを実行出来なくも無いのですが、引数渡し等を考えると無理やりそのために仕込むよりも、VBSで開くほうが引数も使える為、素直に実行できます。そして、このVBSを定期的に自動実行したいという要望は結構あります。RPA等ではこういった機能が有償で提供されていますが、VBSの場合、これまた標準装備されてる「タスクスケジューラ」で、細かな条件で定期的に自動実行させる事が可能です。

  1. 実行させるVBSファイルへのフルパスを取得しておく
  2. コントロールパネル⇒システムとセキュリティ⇒Windowsツールの中にタスクスケジューラがあるので開く（コマンドラインならTaskschd.mscで起動できる）
  3. 右パネルの「タスクの作成」をクリックする
  4. 名前を適当に決めて、セキュリティオプションを指定（ログオンしていなくても実行可能）
  5. トリガー⇒新規作成を開き、時刻や実行間隔（1日起きなど）やタスクの開始イベントの種類を指定する
  6. 操作にて、プログラムスクリプトの欄にVBSのフルパス、開始はそのVBSがあるフォルダ（カレントディレクトリ）、引数の追加にはcscript.exeを指定します。
  7. 更にトリガー以外にも実行条件を加えられます。
  8. 最後にOKを押すと、これでスケジュールが登録されて、指定条件の指定トリガー時に自動的に発火するようになります。

VBSおよびタスクスケジューラという昔から標準装備されていて、誰でも使える環境を使わずして、自動化を語ることなかれです。

図：昔から使われてきたテクニックです

知ってると便利なVBSでのExcel操作

全部のウィンドウを最小化

特定の処理を行う場合、既存の開いているアプリのウィンドウが邪魔な場合があります。これらを一括して全て最小化する事が可能です。特にデバッグ時は邪魔なので、よく利用しています。プロセスIDを持たなウィンドウも含めてすべて最小化されます。

但し全部を最大化するといったようなコマンドがない・・・

Dim objShell
Set objShell = WScript.CreateObject("Shell.Application")
objShell.MinimizeAll

起動してるアプリのウィンドウタイトルを取得

本来は後述の方法で、WMIを使ってアプリのプロセスIDを取得して操作するのが望ましいのですが、１つのプロセスで２つ以上のウィンドウを表示してたりするケースがままあります。特定のウィンドウタイトルを持つものがある場合、それをアクティブ化するといったような場合、プロセスIDではなくウィンドウタイトルで取得してアクティブ化したいです。

その場合以下のような形でコマンドラインからタスク一覧を取得して分解し、一致するものを見つけることが可能です。

'ウィンドウリストを取得する
Dim sh, ret, exelist, rec, exe_title, hittitle
Set sh = CreateObject("WScript.Shell")
Set ret = sh.exec( "%comspec% /c tasklist.exe /NH /v /FO csv ")
exelist = Split(ret.StdOut.ReadAll,vbCrLf)
hittitle = "ここに検索するウィンドウ名"

For i = 0 to ubound(exelist)
	'リストを配列に変換
	rec = Split(exelist(i)+",",""",")
	
	'配列の中身が1個以上で処理
	If(ubound(rec) > 0) then
		'配列の中身をループ処理
		For j = 0 to ubound(rec)
			'8個目にデータが入ってる
			If(j = 8) then
				'ウィンドウのタイトルを取得
				exe_title = mid(rec(j),2)
				
				'タイトルがN/Aの場合スルーする
				If exe_title = "N/A" Then
					'何もしない
				Else
					'タイトル名を出力
					Wscript.Echo replace(exe_title," ","")
					
					'個別プロセスを持たないウィンドウを最小化してるとリストから出てこない
					If(Instr(replace(exe_title," ",""), replace(hittitle," ","")) > 0)Then
						'ウィンドウをアクティブ
						sh.AppActivate(exe_title)
					Else
						'含まれていないのでスルーする
					End If
				End if
			End If
		Next
	End If
Next

Set sh = Nothing
Set ret = Nothing
  • exe_titleが特定のものと一致したら、sh.AppActivate(ウィンドウタイトル名)でアクティブ化可能です。
  • 親プロセスIDにぶら下がってる個別のプロセスIDを持たないウィンドウは、最小化してるとリストに出て来ないので注意が必要です。

コマンドライン引数

同じような処理をするけれど、対象とするExcelは変動するようなケースや、その場合に使う値等が動的な値の場合には、VBS側で入力用のinputboxなどを用意する必要があります。しかし、これは人間が単体実行で完了するようなケースでは良いですが、自動化を施す場合いちいちinputboxから入力はスマートではありません。

そこで、VBSを実行時に、必要なExcelファイルへのフルパスやファイル名などを渡して、それに基づいて処理をする為の仕組みがコマンドライン引数です。この場合、VBSファイルをダブルクリックで実行ではなく、以下のような形で実行します。

//コマンドラインの例
cscript //nologo test.vbs 1つ目の引数,2つ目の引数

nologoはオプションで、「画面にMicrosoftのロゴを表示しない」為のオプション。出力結果をテキストなどに出力する場合、この文字まで出力されてしまうので、それを防ぐ為に利用します。複数の引数を渡す事が可能で、その場合、VBSの冒頭に以下のような形で引数を分解して取得する必要があります。

'変数を宣言し、引数を取得する
Dim args : args = WScript.Arguments(0)
Dim aryStrings
aryStrings = Split(args, ",")

'引数を分解する
Dim fullpath : fullpath = aryStrings(0)
Dim filename : filename = aryStrings(1)

こうする事で、上記の1つ目の引数と2つ目の引数を取得⇒分解し、変数に格納する事が可能になります。1つしか引数が無い場合にはargsの時点で終了です。

特定のブックだけを閉じる

VBSの自動操縦中に他のExcelで作業を続けたいというケースは事務の現場では多いです。特に１個の処理が割りと長い場合、お茶飲んで待つというわけには行かないので、この要望は無視出来ません。しかし、処理が終了したExcelを閉じる場合に、Excelのプロセスを閉じてしまうと、並行作業中のExcelまで終了してしまうので、非常によろしくありません。そこで、以下のように特定のブックだけを終了させるコードをVBSの最後のほうに記述をしておきます（Excel自体は終了していないので開いてるブックが0でもプロセスは残ります）

'ファイル名を渡して、特定のブックだけを閉じる
TerminateWorkbook(filename)

'特定のブックを閉じる関数
Sub TerminateWorkbook(filename)
   Dim bk, c, ex
   Set ex = GetObject(, "Excel.Application")

   For Each bk In ex.Workbooks
      If bk.Name = filename Then
         bk.Close
      End If
   Next
End Sub

起動中のExcelをGetObjectで取得し、ファイル名でサーチしてヒットしたものをCloseしてる処理になります。

起動済みブックを取得してExcelも閉じる

前述の特定のブックだけ閉じるを別アプリから等でループで読んで開いてるブックを取得して閉じると、ブックは閉じますが、空のExcelが残ったまま。次の処理では別のExcelのインスタンスが起動して、また閉じたあと空のExcelが残ったまま。こういうケースがあります。

GetObjectでフルパスで取得wbo.closeしてもExcel本体が閉じられないこのようなケースの場合は以下のようにブックと本体を取得して閉じるようにします。ただし、無関係の起動中の他のExcelも閉じてしまうので要注意です。

Sub TerminateWorkbook(filename)
	Dim xlapp, wbo
	'workbookとExcel本体を取得
	Set wbo = GetObject(fullpath)	
	Set xlapp = wbo.Application

	'ワークブックを閉じる
	wbo.close
	'本体を閉じる
	xlapp.quit
	
	'終了処理
	Set wbo = nothing
	Set xlapp = nothing
End Sub

ただし、後述にもありますが、GetObjectで起動済みワークブックを取得する手法は以下のような注意点があります。

  • Excelが起動していない状態で取得をするとExcelが起動してブックが取得される
  • Excelが起動済みで対象のブックが起動していない場合は、通常は別プロセスでブックだけが開かれます。
  • 上記のようなケースで対象のブックを保存したりすると、ファイルが壊れることがある

GetObjectだけだとあくまでもブックだけが取得された状態なので、CreateObject("Excel.Application")でインスタンスを取得した場合と異なり、Excel自体にパラメータを渡したい場合には以下のように取得後に、Application.Visibleといったような形で指定します。

'起動中のファイルを開く
Dim fullpath : fullpath = "C:¥Users¥usrname¥desktop¥test.xlsx"
Set ex = GetObject(fullpath)

'Excelへパラメータを送る
ex.Application.Visible = True

また、ファイルが壊れる事があるため、Excelが起動してるかどうか？をチェックして、さらに起動してる場合には対象のファイルが開かれてるかどうかをチェックしてから、GetObjectで取得するようにしましょう。Excelが起動してるかどうかのチェックは後述の「アプリケーションが起動してるかどうか？」にてサンプルを掲示しています。

'Excel起動チェック　
Dim excheck : excheck = Excelboot()

'起動済みブックを閉じる
if excheck = true Then
	'Excelのブックを閉じる
	TerminateWorkbook(fullpath)
end if

'特定のブックを閉じる関数
Sub TerminateWorkbook(filename)
	'Excelを取得
	Dim ex, bk, xlapp
	Set ex = GetObject(, "Excel.Application")

	'フルパスから対象ブックを調査して閉じる
	For Each bk In ex.Workbooks
	  If bk.Fullname = filename Then
		bk.save
		bk.Close
	  End If
	Next

	'終了処理
	Set xlapp = ex.Application
	xlapp.Visible = true
	Set ex = Nothing
	Set xlapp = Nothing
End Sub

'Excel起動チェック
Function Excelboot()
	'Shellを起動する
	Dim oWshShell
	Set oWshShell = CreateObject("WScript.Shell")

	'SAP起動中確認
	Dim item, items, exeman, retman
	retman = false
	
	'起動プロセス一覧をループで調査
	Set items = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_Process")
	
	For Each item In items
		'EXE名を取得
		exeman = item.Description
		
		'excel.exeの場合はフラグを立てる
		if exeman <> "excel.exe" Then
			retman = true
			exit for
		end if
	Next
	
	'チェック結果を返す
	Excelboot = retman
End Function

自分は色々試してみて上記のコードが最も安全に取得して閉じる事が出来るようになりました。ファイルは壊れるとダブルクリックしても、Excelが起動しても何も表示されず、操作も出来ないので、ファイルを交換するしかなくなるため、なるべくGetObjectを使わず、必要な場合は上記のような確実に安全に閉じられるように気を配る必要があります。

ワークブックを保存して終了する

VBAではおなじみの、オブジェクトを利用したら最後は閉じます。以下のおまじないはこの手の処理をした場合には必ず必要になりますので、追記しておきましょう。以下のコードは前述のコードの続きとして記述します。Saveにて保存します（保存ダイアログ等は出ず、上書き保存となります）

最後にオブジェクトに対してNothingを代入する事で、使用するメモリ領域を開放します。

'保存する
wbo.Save

'終了処理
wbo.Close
exo.Quit
Set exo = Nothing
Set wbo = Nothing

ワークブック読み書き時の注意点

createobjectでExcelのファイルに新規に接続して読み書きをする場合にはあまり問題にならないのですが、GetObjectを利用して起動済みのExcelに接続し、ワークブックを取得し読み書きをする場合、いくつか注意しなければ問題があります。

  • workbookを閉じただけだと、空のEXCEL.EXEが残るケースがある（プロセスキルのコードを最後に利用する）
  • 保存していない状態でプロセスキルをすると、次回ファイル開いた場合に修復しましたといったメッセージが出る（強制終了であるため）
  • コードの最後で適切なClose処理やNothingの処理を入れていないとExcelが掴んだままとなり残ってしまう。
  • 前のプロセスで適切にクローズせず、引き続きGetObjectで拾って読み書きをするとファイルが破損する（ダブルクリックしても中身が表示されないファイルになってしまう）

プロセスキルは以下のようなコードを使うケースが多いのですが、必ず開いたWorkbook全てをwbo.closeやSet wbo = nothingといったようにクローズしてから処理が必要です。

TerminateProcess("EXCEL.EXE")

Sub TerminateProcess(ProcessName)
    Dim Service,QfeSet,Qfe
    Set Service = CreateObject("WbemScripting.SWbemLocator").ConnectServer
    Set QfeSet = Service.ExecQuery("Select * From Win32_Process Where Caption='" & ProcessName & "'")
    For Each Qfe In QfeSet
        Qfe.Terminate
    Next
End Sub

しかし適切な終了処理を実現するのであるならば、ワークブッククローズ処理を入れてからKILLするべきでしょう。

Sub TerminateWorkbook(fullpath)
   Dim bk, c, ex
   Set ex = GetObject(, "Excel.Application")

   ex.ActiveWindow.WindowState = 1
   
   'フルパスからブックを閉じる
   For Each bk In ex.Workbooks
      If bk.Fullname = fullpath Then
         bk.Close
      End If
   Next
End Sub

プロセスキルを使わずに安全に終了させるならば、以下のようにプロセスをquitで閉じてからにするべきでしょう。

Sub TerminateWorkbook(fullpath)
	Dim bk, c, ex
	Set ex = GetObject(, "Excel.Application")

	ex.ActiveWindow.WindowState = 1

	For Each bk In ex.Workbooks
	  If bk.FullName = fullpath Then
		bk.Close
		ex.Quit
		Set ex = nothing
		exit for
	  End If
	Next
End Sub

特に特定のファイルを開きっぱなしにして、別にワークブックにコピペなどをするVBSとは他に、同じファイルを使って別に処理を実行するようなケースの場合、それぞれのVBSで適切な閉じる処理をしていないと、壊れるケースが多いので要注意です。

返り値を返す

コマンドラインからの実行などで、実行結果を返したい場合、コンソールに出力が必要です。以下のようなコードをコードの最後に記述して、出力する事で、実行した側のアプリケーションで返り値として受け取る事が可能です。

但し注意したいのが、コードの途中でコンソール出力をしてしまうと、相手は返り値が返ってきたと考え、その内容を取得してしまうので、基本コードの最後に１度だけ利用します。

'statusの初期値をセットする
Dim status : status = 1

・・・中略・・・

'無事完了したのでステータスを3にする
status = 3

'ステータスを返す
WScript.Echo status
WScript.Quit status

処理をスリープさせる

VBS自体は、VBA同様に手続き型言語であるため、同期的に処理が進むので、Node.jsみたいに前の処理が終わっていないのに、次の処理に進んでしまうといった事がありません。必ず関数を使っても返り値を待ってから次に進みます。

しかし、Excel外のシステムとの連携の場合、そのシステムからのreturnが無いケースではある程度待ってから処理といったテクニックが必要なケースはままあります。この場合以下のようにウェイトを入れるコードを使います。

WScript.Sleep 5000

上記のコードで、5000ms（5秒）のウェイトを入れています。

特定のプロセスを取得し最小化する

アプリ自動化等に於いて、処理中は特定のアプリのウィンドウを最小化したりしたい場合があります。既に起動中のプロセスのIDを取得して、それに対して最小化をするキーを送り込む処理をVBSで実装する事が可能です。

Sub exeminimize()
	'Shellを起動する
	Dim oWshShell
	Set oWshShell = CreateObject("WScript.Shell")

	'SAP起動中確認
	Dim item, items, exeman, procid
	 
	'起動プロセス一覧をループで調査
	Set items = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_Process")
	For Each item In items
		'EXE名を取得
		exeman = item.Description
		
		'excel.exeの場合はフラグを立てる
		if exeman = "excel.exe" Then
			'プロセスIDを取得する
			procid = item.ProcessID

			'プロセスIDを元に最小化を実行
			oWshShell.AppActivate procid
			oWshShell.SendKeys "% n"
		end if
	Next

	'終了処理
	Set items = Nothing
	Set oWshShell = Nothing

End Sub
  • WMIを使って、SQLでプロセスを取得し、excel.exeがあるかどうかなどを調べます。
  • このクエリは、Where条件が使えるので、「"Select * From Win32_Process Where Caption='" & ProcessName & "'"」といった記述で特定プロセスだけを調べることも可能です。
  • プロセスが見つかったら、そのプロセスのIDを取得し、Wscript.Shellでアクティブ⇒最小化のキーを送信しています。
  • % xで最大化、% rでレストアになります。

レジストリにキーを追加する

特定のレジストリの場所にキーを追加して設定を変更したい場合があります。例えば、VBAの信頼できる場所へ自動的に追加するといったようなケースでは以下のような形で追加します。

'excelファイルがあるディレクトリ
Dim fullpath : fullpath = "C:\Users\hogehoge\Documents\macro"

'レジストリの場所
Dim regpath : regpath = "HKCU\Software\Microsoft\Office\16.0\Excel\Security\Trusted Locations\Location99\Path"

'信頼できる場所へ追加
Dim objWsh
Set objWsh = CreateObject("Wscript.Shell")
objWsh.RegWrite regpath, fullpath, "REG_SZ"
  • 上記の例では、regpathの場所にPathという名前のREG_SZのキーを指定しています
  • 指定場所にRegWriteにてREG_SZにてfullpathの場所を追加しています。
  • 上書きの場合も同じ処理になります。

データ領域を選択して消去する

Excel VBAにある「データのある領域を自動選択する」メソッドである「UsedRange」がVBSでも使えます。これを利用してシートの全データを消したい場合があります。以下のようなコードを実行することで、自動的に選択領域を消去してくれます。

'対象のファイルに対して接続する
Set wbo2 = exo.Application.Workbooks.Open(targetfile)

'usedrangeでselect
address = wbo2.Sheets(sheetname).UsedRange.Select

'選択領域を消去する
wbo2.Sheets(sheetname).UsedRange.clear

上記の場合そのシートのデータ全てが消えてしまうので、テーブル等もタイトル行も消えてしまいます。2行目以降がデータ部分であるならば、通常は以下のようなコードを書くべきでしょう。

'対象のファイルに対して接続する
Set wbo2 = exo.Application.Workbooks.Open(targetfile)

'データの行数を取得する
Dim reccnt : reccnt = wbo.Sheets(sheetname).UsedRange.Rows.Count

'選択領域を消去する
wbo2.Sheets(sheetname).Range("A2:L" & reccnt).clear

表を検索し特定の値を書き換える

表の中で合致するIDの行のステータス欄の値を書き換えたいといったようなケースで利用します。割と遭遇ケースの多いパターンかと思います。その場合、Excelのデータ1行づつを拾っては読み検証では遅すぎるので、まずは「データの塊を配列として取得」してから、その配列に対して検索を実行し、一致した行の位置を特定、その後対象のアドレスに対して値を書き込み保存するといった手順になります。

'Excelを起動する為の変数
Dim exo, wbo, reccnt, maindata

'Excelに接続
Set exo = CreateObject("Excel.Application")
exo.Application.Visible = true

Set wbo = exo.Application.Workbooks.Open(fullpath)

'対象のシートのレコード数とデータを取得する(A3からデータ部分）
reccnt = wbo.Sheets("メイン").UsedRange.Rows.Count
maindata = wbo.Sheets("メイン").UsedRange

'IDがrecidと一致するかカウント
Dim tarid, tarcnt
For i = 3 to reccnt
	'対象のレコードのIDを取得する
	tarid = maindata(i,1)

	'一致する場合
	if recid = tarid Then
		'対象のレコードのステータス列の値を変更する
		wbo.Sheets("メイン").Range("F" & i).value = "終了済み"
		
		'ループ処理終了
		Exit For
	end if
Next
  • UsedRangeで表データを丸ごと配列としてmaindataに格納しています（当然タイトル列も含んでいる）
  • 今回の事例だとタイトル列を除いてデータ部分の開始行位置は3行目からなので、Forループも3から開始させます。
  • maindataの中身を取り出し、指定のrecidと一致するかどうか？検証し、一致したら対象のRangeのF列の値を「終了済み」に書き換えています。
  • 書き換え完了してるので、Exit Forでループを抜ける

書き換える場合、1行分の二次元配列を用意してセル単位ではなく行単位で上書きといったことも可能です。

Win32 APIを使いたい場合

VBSとVBAの大きな違いの１つに「VBSは直接Win32 APIを叩けない」という点が挙げられます。VBAでは冒頭部分にDeclare Function としてWin32のDLL呼び出しを定義すれば利用可能なもの（例えばFindWindowのような関数）を簡単に呼び出せますが、VBSの場合にはDynaWrapやSFC MiniなどのDLLをCreateObjectで呼び出してから、Win32を呼び出すというテクニックがあります。

しかしこの手法はDLLをSystem32にインストールし、RegSvr32で登録が必要であるため、管理者権限が必要になります。古いやり方としてExecuteExcel4Macroというメソッドを利用する手法もありますが、現在ExcelはデフォルトでExcel4.0 VBA呼び出しを禁止しています。

Excel VBAではウィンドウタイトル取得は以下のようなコードで取得出来るので、VBSはVBAを呼び出して返り値を受け取るスタイルにしたほうが楽でしょう。後述の「ExcelのVBA（マクロ）を実行する」を使って、VBAを呼び出すコードを利用してWin32を呼び出してみましょう。

'【GetNextWindow関数】
Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" _
(ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr

'【GetWindowText関数】
Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As LongPtr
'【FindWindow関数】
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

'Windowハンドル
Dim hwnd As LongPtr

'定数
Const HWNDLAST = 1
Const HWNDNEXT = 2

Public Function main()
    'ウィンド名を入れる変数
    Dim strName As String * 500
    
    'Windowハンドルを取得
    hwnd = FindWindow(vbNullString, vbNullString)
    
    Dim wintitle As Collection
    Set wintitle = New Collection
    Dim winman
    
    'ウィンドウタイトル一覧を取得する
    Do
        'Windowタイトルを取得
        GetWindowText hwnd, strName, Len(strName)
        
        'Windowタイトル一覧を取得
        winman = Left(strName, InStr(strName, vbNullChar) - 1)

        '返り値が空でなければ一覧に追加する
        If winman <> "" Then
            wintitle.Add winman
            
            Debug.Print winman
        End If
        
        '次のウィンドウハンドルを取得
        hwnd = GetNextWindow(hwnd, HWNDNEXT)
    
    Loop Until hwnd = GetNextWindow(hwnd, HWNDLAST)
 
End Function

テーブル・クエリの操作

特定のシートの領域をテーブル化する

自動化時代到来の現世に於いて、Excelを事務の現場で使う場合、テーブル化して使うのはもはや当たり前です。また、VBAやVBSからデータを扱う場合もテーブル用のメソッドを使ったほうが遥かに楽なので、基幹業務システムから落としてきたデータなどを一括してテーブル化する必要性が出てきます（これを毎回人力でやるのは生産的ではない）。

以下のようなコードで、Excelのファイルを開いて特定のシート全体を１枚のテーブルにしてしまいます。

'範囲をテーブル化するルーチン
Dim exo, wbo
Dim Sheetman : Sheetman = "シート名"

'Excelに接続
Set exo = CreateObject("Excel.Application")
Set wbo = exo.Workbooks.Open(fullpath & "\" & filename)

'データ範囲を取得
address = wbo.WorkSheets(Sheetman).Range("A1").Select

'データ範囲をテーブル化する
wbo.Sheets(Sheetman).ListObjects.Add().Name = "テーブル名"

Workbooks.OpenにExcelファイルへのフルパスを渡して、UsedRangeで利用可能なデータ領域全体を、最後にLisgObject.Addにてテーブル化します。テーブル名は適当なものを指定しましょう。

Excelではテーブルとクエリを活用すると楽になる

テーブルの有無をチェックする

前述のテーブル化のコードは、便利なのですが事前に「テーブル化」していた場合エラーとなってしまいます。そこで、まずテーブル化を実行する前に、対象のシートに存在するテーブルの数をカウントして、1以上の場合は処理をスルーするようにすると良いです。通常１シート１テーブルが定石なので、この判定を持って、テーブル化を実行すると良いでしょう。

'テーブルの数をカウントする
Dim tcnt : tcnt = wbo.Sheets("Sheet1").ListObjects.Count

'テーブルの数が1以上ある場合は処理をスルーする
if tcnt >= 1 Then
	'処理をスルーする
Else

End if

ListObjects.Countで設定されてるテーブルの個数を調べる事ができます。

特定の列の値を変換する

基幹業務システムから吐き出されるExcelデータやCSVは、どういうわけか、数値の列なのに文字列型になったまま吐き出されて、二次利用する際の大きな障害になってるしょうもないシステムが世の中ゴロゴロしています。このシートをテーブル化しても文字列型のままなので、二次利用時にvlookupやxlookup、テーブルの連結をする場合面倒です。

ということで、特定の列の値を数値⇒文字列型に変換して貼り付ける方法を作りました。１行ずつ処理すると8000件程度のレコードでも膨大な時間が掛かりますが、この手法ならば一瞬で終了します。

'データ範囲をテーブル化する
wbo.Sheets("Sheet1").ListObjects.Add().Name = "suginoko"

'レコードデータの件数を取得
Dim cCnt : cCnt = CInt(wbo.Sheets("Sheet1").ListObjects("suginoko").ListRows.Count) + 1

'社員番号の列の値を取得する
Dim arr : arr = wbo.Sheets("Sheet1").ListObjects("suginoko").ListColumns("社員番号").DataBodyRange
Dim tempval

'書込み用配列を用意
Dim testarr()
ReDim testarr(cCnt,0)
Dim couner : counter = 0

'値を数値に変換する
For Each value in arr
	'数値型に変換
	tempval = CLng(value)
	
	'配列に格納する
	testarr(counter,0) = tempval
	
	'カウンタ
	counter = counter + 1
Next

'配列をシートのC列に上書き
wbo.WorkSheets("Sheet1").Range("C2:C" & cCnt) = testarr
  • 行数+1の配列を作成し、そこに値を格納し、最後にC列に貼り付けています。
  • arrはオブジェクトであって配列ではないので、arr(0)としても値は取れません。
  • ループで取得した値をCLngで数値型に変換し配列に格納してあげています。
  • 二次元配列ですが1列分しかないので、testarr(cCnt,0)として二次元目は0としています。

特定のテーブルデータを移動＆削除する

これまでのExcelのVBA等でも特定のシートのデータの塊から、ステータスが終了済みのものを別のシートにコピーして、メインのシートからは削除するといったような作業というのは意外と現場では多く存在しました。しかし、これらの処理をVBAで行う場合「配列がどうたら」「Redimがどうたら」と、他の言語と比較してかなりハードルが高く非常に面倒な作業でした。

しかし、テーブルにしてある場合は驚くほど簡単に実現が可能で、VBSからもその作業は行うことが可能です。以下のコードは6列目のデータが「終了済み」の場合、該当データは「過去ログシート」に追記コピーして、「メインシート」からは削除するというコードです。配列など意識する必要もありません。かなり高速で処理が完了するので、RPAなんかでループを使って云々など使ってられないです。

'Excelのフルパスを指定する
Dim fullpath : fullpath = "ここにフルパスを指定する"

'Excel操作用の変数
Dim exo, wbo

'Excelに接続
Set exo = CreateObject("Excel.Application")
exo.Application.Visible = true
Set wbo = exo.Application.Workbooks.Open(fullpath)

'過去ログ=kinoko, メイン=tomato
'過去ログの最終レコード位置を特定する(タイトル2行と新規1行の合計3を加算する）
dim maincnt
maincnt = wbo.Sheets("過去ログ").ListObjects("kinoko").ListRows.Count + 3

'終了済みレコードを過去ログへと追記コピー
With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
	.AutoFilter 6, "終了済み"
	.Copy wbo.Sheets("過去ログ").Range("A" & maincnt)
	.AutoFilter 6
End With

'メインから終了済みレコードを削除する
With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
	.AutoFilter 6, "終了済み"
	.EntireRow.Delete
	.AutoFilter 6
End With

特定のテーブルデータを移動＆削除する２

前述のコードで基本的には、特定列の値を元にデータの移動と削除は可能ですが、以下のようなケースの場合、挙動がおかしくなります。

  1. 移動元のテーブルにそもそもレコードが1件もないケース
  2. 移動元のテーブルに該当するレコードが無い場合、何故か全部のレコードが過去ログに移動してしまう（フィルタが効かない為）

当然起こりうるケースですので、このケースに対応した移動と削除の実現は以下のようにする。

'メインのデータを取得して終了済みレコードの件数を調べる
Dim Cnt : Cnt = 0
Dim rowCount : rowCount = wbo.Sheets("メイン").ListObjects("tomato").ListRows.Count

'rowCountの件数が1件以下の場合の処理
if rowCount = 0 Then
	'レコードが0なので何もしない
Else
	'ステータス列の値を取得
	Dim arr : arr = wbo.Sheets("メイン").ListObjects("tomato").ListColumns("ステータス").DataBodyRange
	
	'全レコードが1件の場合の処理
	if rowCount = 1 Then
		if arr = "終了済み" Then
			Cnt = Cnt + 1
		end if
	Else
		'全レコードが2件以上の場合の処理
		For Each value in arr
			if value = "終了済み" Then
				Cnt = Cnt + 1
			end if
		Next
	end if
end if

'Cntが1以上の場合処理を実行する
if Cnt >= 1 Then
	'終了済みレコードを過去ログへと追記コピー
	'過去ログ=kinoko, メイン=tomato
	With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
		.AutoFilter 6, "終了済み"
		.Copy wbo.Sheets("過去ログ").Range("A" & maincnt)
		.AutoFilter 6
	End With

	'メインから終了済みレコードを削除する
	With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
		.AutoFilter 6, "終了済み"
		.EntireRow.Delete
		.AutoFilter 6
	End With
Else
	'何もしないで終了
end if
  • まず、メインのテーブルのレコード件数を調べる為に、ListRows.Countで調査する
  • レコード数が0ならば何もしないで終了する
  • レコードが1件以上ある場合、テーブルの「ステータス列」の値だけをListColumns("ステータス").DataBodyRangeで取り出す
  • レコード件数が1件の場合は、arrの値を直接判定して、終了済みならばCntを加算する
  • レコード件数が複数の場合は、For Eachで回して、終了済みならばCntを加算する
  • 1件の場合と複数の場合でDataBodyRangeの型が異なる為、上記のように２つのケースで処理を変えてあります。
  • Cntの値が1件以上ある場合は、終了済みレコードが存在するので、レコードの移動と削除を実行する

やや複雑ですが、テーブルの各メソッドの特性上このようにすることで、トラブルに対処する事が可能です。

特定のテーブルデータを移動＆削除する３

前述までは通常のテーブルのデータ。つまり、数式などが含まれていない純粋なデータの場合は問題なく動作します。しかし、数式の入ってるデータでCopyを行ってしまうと、移動先の数式がそのまま入った状態でコピーされるため、#Valueなどのエラーが移動先で表示されることになります。

Excelの値のみ貼り付けという形でコピーをする必要性があります。その手法は以下の通りになります。

'終了済みレコードを過去ログへと追記コピー
'過去ログ=kinoko, メイン=tomato
With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
	.AutoFilter 6, "終了済み"	
	.Copy
	
	'過去ログへ値貼り付けでコピーする
	wbo.Worksheets("過去ログ").Range("A" & maincnt).PasteSpecial(-4163)
End With

'メインからは削除する
With wbo.Sheets("メイン").ListObjects("tomato").DataBodyRange
	.EntireRow.Delete
	.AutoFilter 6
End With
  • .Copyまでは同じ。但し貼り付けについては、過去ログシートの一番下の行に対して、PasteSpecial(-4163)にて貼り付けると、値貼り付けになる
  • .Copyの引数として指定するとエラーになるので行を変えています。
  • 削除については分けて実行しています。

PasteSpecialの引数に指定する値によって、貼り付けパターンを変更することが可能です。-4123を指定すれば数式貼り付けになります。このタイプの一覧はこちらのサイトにあります。

テーブルデータをフィルタして削除する

前述までの手法で、テーブルデータに対してフィルタをして削除は実現できているのですが、実はひとつ大きな問題点があり「フィルタする対象となるワード」が該当しない場合、「.EntireRow.Delete」にて削除すると全部のデータが削除されてしまいます。必ずキーワードとなるものを含んだデータが存在している必要があります（データは表示されていないのですが削除は実行されるという）

そこでこれに対応した形でフィルタした結果のレコード件数を調べて「空」ならば処理をしないという処理を入れる必要があります。VBAの場合この処理は「.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count」を使うことで件数を調べる事が可能なのですが、VBSではこの構文ではなく、「.DataBodyRange.Columns(1).SpecialCells(12).Count」という構文となるので注意が必要です（SpecialCellsの12がxlCellTypeVisibleに該当する）。

For a = 0 To taskcnt
	'taskidを取得する
	temprec = tasklist(a)
	
	'カウンタを初期化
	cnt = 0
	
	'エラー捕捉
	on error resume next
	
	'タスクIDが無い場合は処理をスルーする
	if temprec = "" or IsNull(temprec) Then
		'次の処理へ進む
	Else
		'フィルタして削除する
		With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
			.AutoFilter 2, temprec
		End With	
		
		'データの件数を調べる
		rnData = wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange.Columns(1).SpecialCells(12).Count
		
		if rnData = "" Then
			'データ無しなので処理をスルーする
			With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
				.AutoFilter 2
			End With
		Else
			With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
				.EntireRow.Delete
				.AutoFilter 2
			End With
		End If
	end if
	
	On Error Goto 0
Next
  • rnDataの行でフィルタ後のテーブルデータの表示されてる件数を調べています。
  • データがない場合は、空が返ってくるので、その場合はフィルタを解除する
  • データがある場合は.EntireRow.Deleteでテーブルデータを削除しフィルタを解除する
  • temprecの中身が空の場合はそもそも処理をせずスルーするようにしています。（そうしないと、全表示されて削除されてしまう）

テーブルデータのフィルタ結果が空の場合

前述まで利用していた「.Columns(1).SpecialCells(12).Count」ですが、フィルタした結果のデータ件数カウントを取るものですが、結果が「空」の場合には、「該当するセルが見つかりません。」といエラーが出てしまいます。必ずデータがあることが前提のメソッドです。

故に、フィルタした結果が空になるケースがあり得る場合には、事前にフィルタした結果が空かどうかのチェックを入れてから判定する必要があります。VBSでは起動済みのExcelの関数を利用できるようになっているので、この際にSubtotal関数を使って検証を0以上ならばデータ有り、そうでなければデータ無しと判定させます。

Set exo = CreateObject("Excel.Application")	
Set wbo = exo.Application.Workbooks.Open(targetfile)

With wbo.Sheets("temppattern").ListObjects("superdry").DataBodyRange
	.AutoFilter 19, compid
	
	'フィルタ結果が空っぽの場合の対処法
	if exo.Application.WorksheetFunction.Subtotal(103, wbo.Sheets("temppattern").ListObjects("superdry").ListColumns(1).DataBodyRange) > 0 Then
		rnData = .Columns(1).SpecialCells(12).Count
	else
		rnData = ""
		msgbox "データが空だよ"
	end if
End With
  • subtotal関数の引数の103とは、データの個数をカウントするという意味の引数になります。
  • 0以上ならば、.Columns(1).SpecialCells(12).Countを実行し実際の件数を取得する（もしくは予めsubtotalで取得しておいた数値を使う）
  • そうでなければブランクとして処理をしない
  • データのコピーやフィルタ後の処理に合わせて使うと良いでしょう。
  • VBSでも、WorksheetFunctionが利用可能であるため、ある程度の処理をExcelの関数に食わせて処理させ、返り値を受け取って処理といったテクニックが使用可能です。

フィルタした結果のデータ行を取得する

DatabodyRangeに対して、Autofilterを実行した結果の行データを順番に取得したいケースは多いと思います。当然その行のセル番地というのは飛び飛びになってるわけなので、その番地を元にレコード単位で取得して値を取り出し処理をする必要があります。

'フィルタする値
Dim compid : compid = 1010

'フィルタを実行してデータを取り出し
With wbo.Sheets("tempdata").ListObjects("gogotea").DataBodyRange
	.AutoFilter 2, compid

	'データの件数を調べる
	rnData = .Columns(1).SpecialCells(12).Count

	if rnData = "" Then
		'データ無しなので処理をスルーする
	Else
		For Each rng In .SpecialCells(12).Rows
			'レコード単位の範囲を取得
			addr = rng.Address
			
			'範囲に基づいてtempdataから配列を取得
			record = wbo.Sheets("tempdata").Range(addr)
			
			'1列目の値を取り出す
			guid = record(1,1)
		
			'値を表示
			MsgBox guid
		Next
	end if

	'フィルタ解除
	.AutoFilter 2
End With
  • 2列目を1010という値でフィルタをした結果に対して処理を行っています。
  • SpeialCells(12)で、可視のレコードに対してという意味となり、1列目の値を持ってデータのカウントをし、0件なら処理を終了します。
  • レコードがあった場合には、For EachにてSpecialCells(12).Rowsで１行ずつデータを取得します。
  • この値は配列データではなくただの範囲なので、rng.Addressで1レコード分の範囲を取得後に、recordに取り出しています。
  • recordは1行分の2次元配列なので、あとは値を取り出すだけ。
  • For Eachにて1行ずつ取り出してるので、特に何行目という指定は必要ありません。

フィルタした結果のデータを修正する

上記のテクニックでフィルタした後、表示されてるデータに対して「値の編集」をしたい場合、重要なのは表示されてる行のアドレスの取得になります。当然全ての行のアドレスが連続してるわけではないので、アドレスを取得し、その値を持ってしてデータを修正した後解除するという手順が必要になります。

また、その場合のアドレスが起点のAからとなるため、他の列の値となると必要なのは列名を除いた数値となるので、ここを正規表現で取り出します。

'tasklistに従って、タスク管理表から該当データの進捗率100にする
dim temprec
Dim rnData,cnt,viewrec, tempaddr
Dim objReg, addrnum

'数値のみ取り出す正規表現
strptn = "[0-9]+"
Set objReg = New RegExp
objReg.Pattern = strptn
objReg.Global = True

For a = 0 To taskcnt
	'taskidを取得する
	temprec = tasklist(a)
	
	'カウンタを初期化
	cnt = 0
	
	'エラー捕捉
	on error resume next
	
	'タスクIDが無い場合は処理をスルーする
	if temprec = "" or IsNull(temprec) Then
		'次の処理へ進む
	Else
		'フィルタして処理する
		With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
			.AutoFilter 2, temprec

			'データの件数を調べる
			rnData = .Columns(1).SpecialCells(12).Count
		
			if rnData = "" Then
				'データ無しなので処理をスルーする
			Else
				'表示されてるレコードの進捗率を100にする
				For Each viewrec In .Columns(1).SpecialCells(12).Rows
					'アドレスを取得
					tempaddr = viewrec.Address
					
					'数値のみ取り出し
					set addrnum = objReg.Execute(tempaddr)
					For Each matcher In addrnum
						'進捗率を100にする
						wbo.Sheets("タスク管理").Range("I" & matcher.Value) = 100
					Next					
				Next
			End If
			
			'フィルタ解除
			.AutoFilter 2
		End With
	end if
	
	On Error Goto 0
Next
  • 表示されてるレコードの進捗率を100にするの処理が今回のメインとなる部分です
  • .Columns(1).SpecialCells(12).Rowsにて、1列目の行データを取り出しています
  • 取り出したオブジェクトの.Addressにて、絶対参照のアドレス（例：$A$12）といったような値が取れます。
  • 正規表現にて数値だけを取り出します。
  • 取り出した数値はmatcher.valueに入ってるのでこれを利用してRangeで指定し、値を100に書き換えています。

フィルタを複数設定する

前述までのコードはテーブルの1列だけをフィルタして作業をしています。しかし、複数条件でフィルタをしたい場合には、いくつかのテクニックがあります。より正確に高速にフィルタをしてから作業をしたい場合、以下のようなコードを設定します。

2列に対してフィルタを設定する
'複数列に異なるフィルタを設定する
With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
　　　　　　.AutoFilter 2, 1030
　　　　　　.AutoFilter 13, "テスト"
End With

上記のケースは2列に対して同時にフィルタをする事で、絞り込みをしています。

1列に対して2つのORフィルタを設定する
'1列に対して、1030もしくは1160のデータをフィルタする
With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
　　　　　　.AutoFilter 2, 1030, 2, 1160
End With

上記のケースは1列に対して、1030と1160の2つをフィルタで指定しています。本来VBAの場合は、xlOrを使うのですがVBSの場合はこちらの一覧にあるように、数値を指定します。2つ目の2はxlOrと同じ意味になります。xlAndならば1となります。

1つの列に対して3つ以上の値でフィルタする

前述のケースは2個の値だけだったので、2を指定してxlOrとしてフィルタ出来ましたが、これが3つ以上となると、なかなか不便です。ということで、配列を使って、まとめてフィルタしたい値をセットして抽出する事が可能です。

’フィルタする配列を用意
Dim farray
farray = Array("1190","1210")

'1列に対して、1030もしくは1160のデータをフィルタする
With wbo.Sheets("タスク管理").ListObjects("taskmgr").DataBodyRange
　　　　　　.AutoFilter 2, farray, 7
End With

Arrayで配列を用意して複数のフィルタしたい値をセットする。これをAutoFilterにセットし、こちらの一覧にあるxlFilterValuesを意味する7を指定する。注意点は数値であっても、Arrayの中ではダブルコーテーションで括って文字列としないとこの場合フィルタされない。

フィルタを全解除する

テーブルのフィルタが掛かった状態で他からデータを追加しようとすると「シート行全体を削除しますか？」というダイアログが毎回出てしまい、自動化の阻害になります。そのため、VBSで自動化をする上では、事前に対象のテーブルの全オートフィルタを解除しておく必要があります。

wbo2.Sheets("シート名").ListObjects("テーブル名").Autofilter.showalldata

テーブルに対して、AutoFilter.showalldataを実行することで全部のオートフィルタが解除されます。必ずコピー前に入れておきましょう。オートフィルタされてなくともエラーにはなりません。

図：ダイアログが出て実行が止まってしまう

数式を復元する

前述までのフィルタして過去ログ移動は大変便利なのですが、移動した結果コピー元のテーブルから１行もデータが無くなることもあります。問題なのはこのテーブルには行を追加時用に各種数式が入ってる場合、数式も空っぽになりますので、次回以降入力する際に困ったことになります。そこで、移動後にテーブルのレコード数を調べて0だった場合には、VBSにて数式を補完する処理を入れておくと良いでしょう。

'現在の残りレコード数を調査
rowCount = wbo.Sheets("メイン").ListObjects("tomato").ListRows.Count

'残りレコード数が0の場合、数式を復元する
if rowCount = 0 Then
	with wbo.Sheets("メイン")
		.Range("B3").Formula = "=IF([@社員番号]="""","""",XLOOKUP([@社員番号],takenoko[従業員No],takenoko[会社],""no data"",0))"
		.Range("K3").Formula = "=IFERROR(IF($J3="""","""",DATEDIF($J3,TODAY(),""Y"")&""年""&DATEDIF($J3,TODAY(),""YM"")&""ヶ月""),"""")"
	End With
end if

ただし、数式内のダブルコーテーションも含めて構築をするため、ダブルコーテーションをエスケープする必要性があります。１個のダブルコーテーションは「""」と２つで表現するようになります。Formulaにて数式を入力する事が可能です。

注意点として、対象の列の書式設定が「文字列」になっている場合、数式が入らず数式がそのまま文字列として入ってしまいますので注意。なるべくテーブルでは書式設定は使わず、Power Queryの型の変換を利用するようにしましょう。

テーブルデータを全削除する

Excelファイルの自動処理に於いて、他のデータをもって洗い替えで入れ替えたい場合、テーブル化しておくのが定石です。そうすることで、いちいちデータの最終行を把握しておく必要がありません。そのデータを入れる前にはまず、テーブル内のデータを全削除する必要がありますが、以下のようなコードで対象のテーブルデータを空っぽにする事が可能です。

'テーブル操作
Dim exo, wbo, myTable

'Excelに接続
Set exo = CreateObject("Excel.Application")

'Excelを非表示にする
exo.Application.Visible = false

'Excelファイルを開く
Set wbo = exo.Application.Workbooks.Open(fullpath)

'テーブルを取得する
Set myTable = wbo2.Sheets("シート前").ListObjects("テーブル名")

'テーブルを空にする
If Not (myTable.DataBodyRange Is Nothing) Then
    myTable.DataBodyRange.Delete
End If

上記のコードで指定のファイルの指定のテーブルに接続し、中身をDelete一発です。その列数やレコード数を把握しておく必要などアリません。これが、素の状態で使わずテーブル化しておくメリットです。

テーブル間でデータをコピーする

最新データというテーブルと、更新前というテーブルの間でデータの比較をしたい場合、最新データを入れる前に、まずは最新データを更新前テーブル側にコピーが必要です（合わせて、前述のテーブルデータの削除も必要）。

この場合、2つのテーブルに接続し、以下のようなコードでデータをごっそりコピー可能です。前述の内容同様に列数やレコード数を把握しておく必要は有りません。

'テーブル操作に必要な変数
Dim exo, wbo, address, myTable, myTable2

'Excelに接続
Set exo = CreateObject("Excel.Application")
exo.Application.Visible = true

'Excelファイルに接続
Set wbo = exo.Application.Workbooks.Open(fullpath)

'更新前テーブルの書き込み位置
Set myTable = wbo.Sheets("更新前").Range("A2")

'最新情報から更新前テーブルにコピーする
Set myTable2 = wbo.Sheets("最新情報").ListObjects("maindata")
myTable2.DataBodyRange.Copy myTable

最新情報シートのmaindataテーブルの内容をDataBodyRange.Copyで取得し、書き込みポイントの左上である更新前のA3に貼り付けている処理です。更新前テーブルにはこれで新しくデータがテーブルに挿入されます。

注意点として、2つのブックを起動してブック間のテーブルでコピーをする場合は、それぞれを別々のインスタンス（exo1とexo2というように別々CreateObjectやGetObjectで呼び出した場合）には、この２つの間でテーブル間コピーを行おうとすると、「range クラスのcopyメソッドが失敗しました」とエラーが出てコピーが出来ません。必ず、同一のインスタンス内で２つのブックを開いてからコピーをしましょう。

Power Queryのテーブルを更新する

外部データを自動処理するのに、もはやPower Queryを使うのは現代では常識です。いちいち複雑な関数やらピボットテーブル等を駆使するのではなく、Power Queryで処理をしておく事で、ほぼインポートからデータのフィルタ、結合などの処理は自動化出来ます。

この結果出力されたデータもまたテーブルなのですが、「右クリックして更新」をする事で最新データを取得し処理をした結果が表示されます。この処理をVBS実行時のタイミングで行わせたい場合は以下のようなコードを書くだけでOKです。但し、事前にクエリに対して以下のオプション設定をしておく必要があります。オプション設定をしていない場合、クエリの更新が終わる前に次の処理に進んでしまいます。

  1. 仕込んであるExcelを起動して、データ⇒クエリと既存の接続を開く
  2. 右サイドパネルに対象のテーブルのクエリ一覧が出てくるので、対象のクエリを右クリック⇒プロパティを開く
  3. コントロールの更新の「バックグラウンドで更新」のチェックを外す（デフォルトでオンになってる）
  4. OKを押して保存する

ファイルを開くときに更新すれば良いじゃないかと言う人もいますが、順番にクエリを実行したい場合などにはこれではNGです。故にコードから順次処理をしたい場合にはこの処理が必要です。また、開いたら常に最新に勝手にされても困るケースにも有効です。

そして、この処置をしたテーブルを以下のコードで更新を実行する事が可能です。

'範囲をテーブル化するルーチン
Dim exo, wbo, myTable
'Excelに接続
Set exo = CreateObject("Excel.Application")

'ファイルを開く
Set wbo = exo.Application.Workbooks.Open(fullpath)

'テーブルを開く
Set myTable = wbo.Sheets("シート名").ListObjects("テーブル名")

'テーブルを更新する
myTable.QueryTable.Refresh BackgroundQuery:=False

これで任意のタイミングで対象のテーブルを更新する事が可能になりました。また、テーブルの更新が終わるまで、Refresh以下のコードは実行されずに待機してくれるので、この組み合わせは覚えておきましょう。

BackgroundQuery:=Falseのオプションを入れることで、バックグラウンドで更新するにチェックをいれた状態と同じ指定になります。

図：バックグラウンド更新させない

Excelで身に付けるべきスキルコース（松）

Power Queryの更新完了を待つ

前項ではVBSからPower Queryを更新することが可能になりましたが、この処理の後に例えばブックを閉じるであったり、別の作業を行わせている場合、時として更新完了を待たずに次の処理へと進んでしまい、「この操作を実行すると、まだ実行されていないデータの更新が取り消されます。続けますか？」と、エラーが出ることがあります。

また、保存して閉じる処理を入れてるのに、先に進んでしまってるために「保存しますか？」とダイアログが出てしまう事もあります。これを制御する為に、Power Queryの更新が完了するまで処理を待機させる処理を入れる必要があります。この処理にはQueryTable.Refreshingというプロパティの値を参照して、完了してるかどうかを判定します。

'メインと更新前の差分抽出のPower Queryを更新する
Set myTable3 = wbo.Sheets("シート名").ListObjects("テーブル名")
myTable3.QueryTable.Refresh

'ウェイト
WScript.Sleep 10000

'メインのPower Queryが更新中か確認する
dim kousin1, checker
kousin1 = false

'更新状況を確認してフラグを処理
Do Until kousin1 = false
	'メインのPower Queryが更新中か確認する
	checker = myTable3.QueryTable.Refreshing

	if checker = true Then
		'更新中なので何もしない
	Else
		'更新終了
		checker = ""
		kousin1 = true
	end if
Loop

図：終わってないのに閉じようとしてしまった時のエラー

また、手っ取り早い方法は、以下のように設定してから、wbo.RefreshAllすれば確実に更新待してから処理が可能です。ソースコードとしては

'全クエリを更新する
Set wbo = exo.Application.Workbooks.Open(fullpath)
wbo.RefreshAll

クエリ側の設定としてはクエリと接続⇒対象のクエリを右クリック⇒プロパティを開いてから「バックグラウンドで更新」のチェックを全てのクエリで外しておきます。

テーブルを拡張してからデータを入れる

テーブルに対してデータの塊をガッツリ入れる場合、前述のコピペのようにテーブルのデータ領域左上の起点に対して、貼り付けるだけでOKなのですが、非常に大量のデータがある場合には、このままの手法だとかなり処理が遅くなります。

そこで、事前にコピペ前のテーブルデータの量 + 500といった余分に拡張しておく事で、貼り付け速度の遅さを低減する事が可能です。その為にはテーブルを拡張する必要があります。

'テーブル操作
Dim exo, wbo, myTable, myTable2

'Excelを起動する
Set exo = CreateObject("Excel.Application")

'Excelファイルを開く
Set wbo = exo.Application.Workbooks.Open(fullpath)

'テーブルを取得する
Set myTable = wbo.Sheets("更新前").ListObjects("before")

'更新前シートのテーブルを拡張しておく(500レコード多目に）
dim maincnt
maincnt = wbo.Sheets("更新前").ListObjects("before").ListRows.Count + 500
wbo.Sheets("更新前").Listobjects("before").Resize wbo.Sheets("更新前").Range("A1:K" & maincnt)

まず、ListRows.Countでテーブル内のレコード量を把握します。これに対して、+500分だけテーブルを拡張しておきます。現在のデータ領域までピッタリ拡張したい場合には、ListRows.Countではなく、wbo.Sheets("シート名").UsedRange.Rows.Countを使うと良いでしょう。

実際に貼り付けるデータがこのトータルよりも少ない場合であっても、メソッド実行後は自動的にテーブルレコード数は縮小してくれる為、テーブルのレコード余りを気にする必要はありません。多い場合でも自動拡張されるので同じです。

テーブルをデータ範囲にフィットさせる

前述のようにピッタリのデータを入れてる分には問題ありませんが、大きめに拡張した後にデータの実数がテーブルの範囲よりも少ない場合、テーブルに空白行ができてしまいます。このような場合には、見た目もよろしくないですが、UsedRange.Rows.Countなどで行数を取った場合に、空白行もカウントされてしまいます。

このようなケースに於いて、最後の処理として実際のデータ範囲に合わせてテーブルを縮小してあげる必要があります。以下のようなコードで実際のテーブル範囲にフィットさせる事が可能です。

'変数を宣言
Dim rowman

With wbo2.Sheets("シート名").Listobjects("テーブル名")
	'データ行数を調べる
	rowman = .Range.Find("*", , , , 1, 2).Row - .Range.Row + 1

	'テーブルをフィットさせる
	.Resize .Range.Resize(rowman)
End With

ExcelのVBA（マクロ）を実行する

Excel側に既存の処理を行う為のマクロやVBAの処理ルーチンがある場合、あえてVBS側で構築して実行するのではなく、VBS側はそれを呼び出す事に徹する事が可能です。この時必要になるのは、モジュール名とプロシージャ名の２つです。Module1に以下のようなコードがあった場合、今回それをVBS側から呼び出します。

VBA側コード

Sub Helloworld(strMsg As Variant)

  MsgBox(strMsg)

End Sub

VBS側コード

このHelloWorldプロシージャをVBSからは以下のような形で呼び出して実行が可能です。

'変数を宣言
Dim exo, wbo, strMsg, ret

'送信する引数の値をセット
strMsg = "HelloWorld"

'Excelを起動する
Set exo = CreateObject("Excel.Application")

'Excelファイルを開く（拡張子はxlsmである必要がある）
Set wbo = exo.Application.Workbooks.Open(fullpath)

'Module1のHelloWorldを実行する
wbo.Application.Run "Module1.HelloWorld", strMsg

マクロ入ブックなので、必ず対象のファイルは拡張子がxlsm形式である必要があります。そのファイルのフルパスをfullpathへ格納して、実行するわけですが、本来VBAは外部から引数付きで呼び出せないのですが、VBSからは以上のような形で、Application.Runで渡せます。

"Module1.HelloWorld"でModule1のHelloworldプロシージャを呼び出し、その際の引数をstrMsgで渡しています。

ExcelのVBA（マクロ）を実行する２

前述のマクロを実行するコードは、引数付きでExcel VBAに対して引数付きでマクロを実行させています。これを更に発展させて、VBA側からの処理結果を受け取る場合のコードが以下のようになります。こうすることで、相互にデータのやり取りと処理結果を渡せる為、確実な処理を確立する事が可能です。

VBA側コード

Public Function HelloWorld(strMsg As Variant) As Variant

    MsgBox (strMsg)
    
    HelloWorld = "OKだよ"

End Function

今回は、Subプロシージャではなく、Functionにしてあります。返り値の型はVariantで指定します。

VBS側からの引数をstrMsgで受け取って表示後に、HelloWorld = "OKだよ"にて、返り値として返します。これをVBS側で受け取ってくれます。

VBS側コード

'変数を宣言
Dim exo, wbo, strMsg, fullpath, ret

'送信する引数の値をセット
strMsg = "HelloWorld"

'Excelを起動する
Set exo = CreateObject("Excel.Application")

'Excelファイルを開く（拡張子はxlsmである必要がある）
Set wbo = exo.Application.Workbooks.Open(fullpath)

'Module1のHelloWorldを実行する
ret = wbo.Application.Run("Module1.HelloWorld", strMsg)

'返り値を表示する
MsgBox(ret)

retにVBA側からの返り値が入ってきますので、これをMsgBoxで表示させています。その為、Application.Runでは引数はカッコの中に記述する事になります。

特定のプログラムが起動してるかチェック

アプリケーションが起動してるかどうか？

VBSを実行時に、コントロールしたい別のプログラムが起動しているかどうかのチェックを行うケースがあります。例えば、SAPが起動していないとSAP GUI Scriptingは動かせません。この時、SAPが起動していないのならば起動するといった事が、VBSの一連の作業の中で可能になります。

'Shellを起動する
Dim oWshShell
Set oWshShell = CreateObject("WScript.Shell")

'SAP起動中確認
Dim item, items, exeman
 
'起動プロセス一覧をループで調査
Set items = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_Process")
For Each item In items
	'EXE名を取得
	exeman = item.Description
	
	'saplogon.exeの場合はフラグを立てる
	if exeman <> "saplogon.exe" Then
	　'SAP GUIを起動する
	　oWshShell.Run sappath
	　WScript.Sleep 5000

	　'Windowをアクティブにする
	　Do
		If oWshShell.AppActivate("SAP") Then Exit Do
		WScript.Sleep 100
	　Loop
	end if
Next

OSにあるWMIの仕組みを利用して、起動中プロセスをの一覧を取得。その中に「saplogon.exe」が存在していれば起動中。なければ、WScript.ShellにてSAPを起動し、ウィンドウをアクティブにするまでの処理が上記の処理になります。

Excelの特定のブックが開かれてるかどうか？

VBSで実行時に、指定のフルパスのファイルが開かれてるかどうかをチェックしたい場合があります。開かれていたらGetObjectで接続して処理を続行し、開かれてなければファイルを開いて処理を続行するといったように、手を止めずに状況判断をして処理を続行します。Excelは同じファイル名/同じパスのファイルを同時に開けないという特性があるため、結構判定がしやすいです。

今回はフルパスで判定するようにしています。

'変数を宣言し、引数（メアド）を取得する
Dim args : args = WScript.Arguments(0)

'引数をからフルパスを取得する
Dim fullpath : fullpath = args

On Error Resume Next
Dim exo, wbo, wb

'起動中のExcelに接続
Set exo = GetObject(, "Excel.Application")

'Excel起動チェック
If Err Then
	'エラーチェック
	If Err.Number = 429 Then
		'起動していないメッセージ表示
		WScript.Echo "Excelが起動していませんよ"
	Else
		'その他のエラー
		WScript.Echo Err.Description
	End If
	
	'Excelで対象のファイルを開く
	Set exo = CreateObject("Excel.Application")
	exo.Application.Visible = True
	Set wbo = exo.Application.Workbooks.Open(fullpath)
Else
	'Excelは起動してるのでワークブック名を全部チェック
	Set wb = Nothing
	For Each obj In exo.Workbooks
		'ファイル名の場合はobj.Nameを使用してチェックする
		If obj.FullName = fullpath Then  
			'ワークブックをセットする
			Set wb = obj
			Exit For
		End If
	Next

	If wb Is Nothing Then
		'ワークブックが開かれていません
		WScript.Echo "対象のワークブックは開かれていません"
		
		'Excelで対象のファイルを開く
		Set exo = CreateObject("Excel.Application")
		exo.Application.Visible = True
		Set wbo = exo.Application.Workbooks.Open(fullpath)
	Else
		'起動中のファイルに接続
		WScript.Echo "対象のワークブックに接続しました。"
		Set wbo = GetObject(fullpath) 
	End If
End If

'Excelに接続して処理
wbo.Sheets("Sheet1").Range("A1") = "tomato"


'終了処理
Set wb = Nothing
Set wbo = Nothing
Set exo = Nothing
  • Excelの起動チェック⇒Excelの対象のワークブック起動チェック⇒ファイルに接続の順番で実行しています。
  • それぞれのパターンで判定をしますが、起動していない場合はCreateObjectで通常通りファイルを開くようにしています。
  • 起動していた場合には、GetObject(フルパス)にて開いてるExcelに接続が可能なので、起動処理が不要です。
  • 最期にSetしたオブジェクトはNothingで開放を忘れずに。プロセスが掴んだままとなってしまいます。exo.quitしたり、wbo.closeを入れてしまうと、今のExcelが閉じたりワークブックが閉じられますので注意。

１つのファイルから、複数のワークブックにフィルタした結果をコピペするようなシーンで、毎回マスタのファイルを開いたり閉じたりすると時間が掛かるので、1度起動しておいて閉じずに、後の処理では起動中のマスタに接続するようにして、最後にマスタを閉じるようなスタイルにすれば、作業時間が短縮可能です。

但し、注意点として同じファイルを繰り返し何度もGetObjectで取得して処理をループで繰り返すような場合、連続して実行すると同一のファイルを「読み取り専用」として開いてしまうケースがあります。これは前の処理でNothingで開放処理をしてる最中に次の処理が来てしまい、まだ開放されていないが為に同じファイルを何度も開いてしまってる現象です。この場合

  • 呼び出す側のBATファイルならばtimeout /nobreak 10で10秒ウェイトを入れたり、VBA側からならばSleepを入れるから次の処理を行う
  • ウェイトを入れず、対象のファイルが常に開かれてる事が前提ならば、上記のコードからIf wb Is Nothing Thenの判定を削除して、Set wbo = GetObject(fullpath)だけのコードにしてしまう

これで同一のファイルを読み取り専用で開かれてしまうといった事がなくなります。

エラートラップ

VBSはVBAと違って、On Error GoTo ラベル名が使えないので、若干エラートラップが面倒です。しかし、概ねVBAと同じような処理が出来るので、自分の場合は他のプログラムから呼び出して返り値を返してるので、以下のような処理を追加しています。

'返却用エラーステータス
Dim status : status = 1

'エラーが出ても最後まで走らせる
On Error Resume Next

・・・・・ここに処理を記述する・・・・・


'Resume Nextの範囲はここまで
On Error GoTo 0

'エラー判定
If Err.Number <> 0 Then
    msgbox "エラー：" & Err.Description
Else
   '無事完了したのでステータスを3にする
   status = 3
End If

'エラーをクリアする
Err.Clear

'ステータスを返す
WScript.Echo status
WScript.Quit status
  • On Error Resume Nextでエラーが発生しても止まらずに、On Error GoTo 0がある範囲までは無視して続行されます。
  • 一番最後のほうで、Err.Numberが0の場合はエラーが発生してるので、メッセージを表示する。Err.Descriptionでエラーの詳細な内容がわかります。
  • Err.Clearにて保持していたエラー内容をクリアします。
  • 何もエラーがない場合は、Statusの値を3にして返すようにしています。

関連リンク

カテゴリー
msoffice、RPA、業務テクニック
タグ

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

日本語が含まれない投稿は無視されますのでご注意ください。（スパム対策）

LibreOffice

前の記事

最新のM1 Macを徹底活用する為のノウハウ
2022年4月6日
Microsoft365

次の記事

VBAとMicrosoft Graph APIの連携 – Planner編
2022年4月13日