RCIE-ジャンクのコード屋

主に自分のためにコーディングのTIPSを蓄積しています。

【VBA】 新規ブックに現在のブックのシートを全てコピーする - Copy

やりたいこと

  • マクロ入りのブック(.xlsm)を開いている。
  • そのブックの中には、複数のシートがある。
  • VBAを使って、そのすべてのシートを新規ブックにコピーしたい。

方針

  • シート(1) をコピーして、新規ブックを作成する。
  • シート(2) を、新規ブックにコピーする。
  • シート(3) 以降も同様に、新規ブックにコピーする。

ソースコード

'画面の更新を止めて、処理を速くする。
Application.ScreenUpdating = False

'コピーしたいブック
Dim wb As Workbook
Set wb = ThisWorkbook

'コピー先のシート
Dim sh As Worksheet

'シート(1)をコピーする。
'この場合、コピー先の指定がないので、新規ブックを作成する
Call wb.Sheets(1).Copy
Set sh = ActiveSheet

'シート(2)以降をコピーする。
'コピー先は、新規ブックの末尾。
Dim i As Long
For i = 2 To wb.Sheets.Count
	Call wb.Sheets(i).Copy(After:= sh)
	Set sh = ActiveSheet
Next

'画面の更新を再開する。
Application.ScreenUpdating = True

解説

Worksheet.Copy メソッドで、シートのコピーを作成できます。
Call wb.Sheets(1).Copy のように、引数無しで実行すると、新しいブックにシートを作成します。
Call wb.Sheets(i).Copy(After:=sh) のように、引数「After」を指定すると、そのシートの後ろに作成します。
作成したシートはアクティブになるので、ActiveSheet で取得することができます。

コピー元とコピー先でブックのフォーカスの移動が発生するので、コピーするシートの数が増えると、チカチカします。

【VBA】外部プログラムの実行 標準入出力あり(WScript.Shell / Exec / StdIn / StdOut)

VBA

やりたいこと

VBAから外部プログラムを呼び出して、その出力をVBAで利用したい。
ただし、その外部プログラムは対話型※ なので、標準入力からいろいろ入力したい。

※対話型：プログラムがユーザーに質問をする。ユーザーが答えると処理を継続する。

例えばこういう状況

実行しているコンピュータのメモリ容量を知りたい としよう。

コマンドプロンプト（cmd.exe）を起動して「SYSTEMINFO」と入力すればメモリ容量がわかる。



システム ディレクトリ:  C:\WINDOWS\system32

起動デバイス:           \Device\HarddiskVolume1

システム ロケール:      ja;日本語

入力ロケール:           ja;日本語

タイム ゾーン:          (UTC+09:00) 大阪、札幌、東京

物理メモリの合計:       15,789 MB

利用できる物理メモリ:   8,896 MB

仮想メモリ: 最大サイズ: 18,221 MB

仮想メモリ: 利用可能:   9,311 MB

仮想メモリ: 使用中:     8,910 MB

つまり、以下の処理を行えばよい。

  • cmd.exe を起動する
  • 「SYSTEMINFO」と標準入力から打ち込む
  • システム情報が表示されるまでちょっと待つ
  • 「EXIT」を入力して終了する
  • 得られた標準出力から、メモリ容量のところを抜き出す
  • ダイアログボックスに表示する

これをVBAで実現してみよう。

コード

Option Explicit

'外部プログラムを実行する
Dim oExec
With CreateObject("WScript.Shell")
	Set oExec = .Exec("cmd.exe")
End With

'標準入力に以下の入力を積んでおく
oExec.StdIn.WriteLine("SYSTEMINFO")
oExec.StdIn.WriteLine("EXIT") 'cmd.exe はこれがないと終了しない

'標準出力をすべて取得し、改行で区切る
Dim sOut
Do Until oExec.StdOut.AtEndOfStream
	sOut = sOut & oExec.StdOut.ReadLine() & vbCrLf
Loop

'物理メモリの合計が書かれている行を探す
Dim sEach
Dim sMemory

For Each sEach In Split(sOut, vbCrLf)
	If InStr(sEach, "物理メモリの合計:") = 1 Then
		sMemory = sEach
	End If
Next

'ダイアログボックスに物理メモリの合計を表示
MsgBox sMemory

'ついでに標準出力をファイルに書き込む
'テキストファイルを開く　…　モード=書き込み、ファイル形式=規定値
With CreateObject("Scripting.FileSystemObject").OpenTextFile("StdOut.txt", 2, -2)
	'書いて閉じる
	.Write(sOut)
	.Close
End With

解説

Dim oExec
With CreateObject("WScript.Shell")
	Set oExec = .Exec("cmd.exe")
End With

外部プログラムとして、コマンドプロンプト（cmd.exe）を実行する。
.Exec では非同期実行をするので、cmd.exe の終了を待たずに次の行を実行する。

oExec.StdIn.WriteLine("SYSTEMINFO")
oExec.StdIn.WriteLine("EXIT")

oExec.StdIn.WriteLine を実行すると、標準入力に文字列を流し込める。
コマンドプロンプトで、「SYSTEMINFO(Enter)」と「EXIT(Enter)」をキー入力したのと同じ効果が得られる。

Dim sOut
Do Until oExec.StdOut.AtEndOfStream
	sOut = sOut & oExec.StdOut.ReadLine & vbCrLf
Loop

プログラムが終了すると、oExec.StdOut.AtEndOfStream は True になる。
標準出力は、oExec.StdOut.ReadLine で１行ずつ取得することができる。
もし、コンソールが入力待ちになっている時に AtEndOfStream や ReadLine を実行すると、そこから先は処理がブロックされて停止してしまう。（今回の罠）
したがって、入力待ちにならないように、外部プログラム（cmd.exe）が終了するまで oExec.StdIn.WriteLine で標準入力に流し込んでやる必要がある。

【アルゴリズム】シェルソートの速度を考察した

ソート 計算機科学 JavaScript ベンチマーク

はじめに

前提：挿入ソートとは何か

  • 「挿入ソート」とは、以下のようなソートアルゴリズムである。
    • 配列Ｎ番目（Ｎ≧２）の数字に注目する。
    • その数字が左隣の数字より小さい間は、左隣の数字と交換し続ける。
    • 配列Ｎ＋１番目の数字に注目する。
    • その数字が左隣の数字より小さい間は、左隣の数字と交換し続ける。
  • 図を見た方が分かりやすい。赤字のところが交換した箇所である。

63045812711109
36045812711109
30645812711109
03645812711109
03465812711109
03456812711109
03456182711109
03451682711109
03415682711109
03145682711109
01345682711109
01345628711109
01345268711109
01342568711109
01324568711109
01234568711109
01234567811109
01234567810119
01234567810911
01234567891011

挿入ソートの特徴

  • 交換回数が少ない。
  • 1000くらいの要素なら、実用的な速さで動く。
  • (要素数)2 に比例した回数の比較処理を行うため、100万要素の並べ替えは現実的な時間ではできない。（2022年の時点）

挿入ソートの比較回数（ランダム配列の場合）

  • 要素数をNとして、比較回数は 0.24 N2 に近似できる。

要素比較回数交換回数
103226
31245215
10029642870
3162428523981
1000234963233974
316224456242442476
100002388683323876841

  • もし、100万要素の並べ替えを行うなら、じつに 2400億回 もの比較が必要になる。
  • これを執筆しているPCでは、約7200秒(＝120分)かかる見積もりだ。

改良版挿入ソート「シェルソート」

  • ドナルド・シェルが、1959年に発表したソートアルゴリズム。
  • 「挿入ソートは隣同士しか交換しないから遅い」という欠点を克服すべく、離れた位置の要素を交換するように改善した。
  • まずは、4n番目(0, 4, 8, 12, …)の要素を挿入ソートする。つまり4つ離れた位置の挿入ソート。
  • つぎに、4n+1番目(1, 5, 9, 13, …)の要素を挿入ソートする。
  • つぎに、4n+2番目(2, 6, 10, 14, …)の要素を挿入ソートする。
  • つぎに、4n+3番目(3, 7, 11, 15, …)の要素を挿入ソートする。
  • 最後に、n番目(0, 1, 2, 3, …)の要素について普通の挿入ソートをする。
  • 4n番目などの挿入ソートを最初に実行している分、遅くなりそうな雰囲気があるが、実際にはそうではない。
  • 図を見た方が分かりやすい。赤字のところが交換した箇所である。

11109876543210
71098116543210
71098365411210
31098765411210
36987105411210
36987254111010
32987654111010
32587694111010
32587614111090
32187654111090
32147658111090
32147650111098
32107654111098
23107654111098
21307654111098
12307654111098
12037654111098
10237654111098
01237654111098
01236754111098
01236574111098
01235674111098
01235647111098
01235467111098
01234567111098
01234567101198
01234567109118
01234567910118
01234567910811
01234567981011
01234567891011

  • 交換する距離は、配列の大きさによって変更する。

なぜ速いのか

  • 4つ離れた位置ごとのソートが済んでいる場合、普通のソートの実行時間は大幅に短縮されるから。（上の表を参照)
  • 要素数がさらに大きいときは、挿入ソートをする間隔を以下のように広げていく。
    • 1 → 4 → 13 → 40 → 121 → (3倍+1)

シェルソートの比較回数（ランダム配列の場合）

  • 要素数をNとして、比較回数は 3.5 N1.2・(logeN)0.1 に近似できる。
  • Wikipedia には、N1.25 のオーダーと書いてあるが、こちらの方が実測値に近い。

要素数比較回数交換回数
101910
3113583
1001062881
31643333437
10001743613634
31627096655731
10000274549216244
316221123988907860
10000039637733101598
3162271619158713143666
10000006408612053433454

挿入ソート VS シェルソート

要素数
N		 挿入ソート
0.24 N2		 シェルソート
3.5 N1.2・(logeN)0.1		 速度比
1000 240000 15552 15倍
10000 24000000 253673 95倍
100000 2400000000 4111166 584倍
1000000 240000000000 66356454 3617倍

JavaScript での実装

function shellSort(ary){
	// 最初の交換間隔を決める(1→4→13→40→121→...)
	let d = 1;             // d : 交換間隔
	let z = ary.length;    // z : 配列長
	let dmax = z / 30 | 0; // 最初のdは配列長の1/9程度が良い
	while(d <= dmax){
		d = d + d + d + 1;
	}
	// 交換間隔が0になったら終了
	while(d > 0){
		// i : 交換間隔の分だけ繰り返す(間隔が40なら40回)
		for(let i = 0; i < d; i++){
			// j : i～末尾まで繰り返す
			for(let j = i; j + d < z; j += d){
				// k : j～先頭まで繰り返す
				for(let k = j; k >= 0; k -= d){
					// 左が大きい場合は交換する
					// 右が大きい場合はjを進める
					if(ary[k] > ary[k + d]){
						[ary[k], ary[k + d]] =
							[ary[k + d], ary[k]];
					}else{
						break;
					}
				}
			}
		}
//		交換間隔を小さくする(121→40→13→4→1→0)
		d = d / 3 | 0;
	}
}

その他、シェルソートの特性

  • ソート済配列の先頭や末尾に追加した場合、比較回数は O(N log1.2N) のオーダー。
    • 先頭や末尾に k個 追加した場合の比較回数（実測値）の近似値は、
      1.2 N・loge(k・N)1.2
    • 挿入ソートの末尾追加のオーダーは O(N) であるから、その場合では挿入ソートの方が有利になる。

まとめ

  • N個のランダム配列では、シェルソートの比較回数は 3.5 N1.2・(logeN)0.1 だと判明した。
    参考までに、JavaScriptで整数の配列をソートする場合、1億回の比較に3秒かかる。
  • シェルソートは22行で実装できるので、挿入ソートをシェルソートに置き換えるのはいいぞ。

【VBA】 Excelシートの書式・条件付き書式を変更できないようにする

VBA Excel

困ったこと

  • Excelの条件付き書式は、セルをコピーするとルールが増殖する。
  • カット＆ペーストすると、書式範囲が飛び飛びの穴開きになってしまう。
  • いつの間にか増殖しすぎて、ルール数が1000を超えていることもある。
  • そうなってしまうとメンテナンスは不可能。

今回やりたいこと

  • Excelでセルをコピーしても条件付き書式が増殖しないように固定化したい。

方針

  • ブックを開いたら、対象のシートをまるごとコピーして退避する。
  • 保存するタイミングで、退避先シートから書式を復帰する。

コード

'ThisWorkbook に記述する
Option Explicit

'条件付き書式を固定するシートの番号(変更可能)
Const Nシート番号 = 1

'書式退避先のシート名(変更可能)
Const S退避 = "書式退避"

'保存時に書式が復元される
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
	'画面描画を省略して高速化
	Application.ScreenUpdating = False
	'退避シートが存在しなければジャンプ
	On Error GoTo NOT_EXIST
	Sheets(S退避).Visible = False
	'退避シートが存在する場合の処理======
	'退避シートの全セルの書式をコピペ
	Sheets(S退避).Cells.Copy
	Sheets(Nシート番号).Cells.PasteSpecial xlPasteFormats
	Application.CutCopyMode = False
	'画面描画を再開する
	Application.ScreenUpdating = True
	Exit Sub
NOT_EXIST:
	'退避シートが存在しない場合の処理======
	'現在位置を覚えておく
	Dim rg As Range
	Set rg = Selection
	'退避シートをコピーにより作成し、非表示にする
	Sheets(Nシート番号).Copy After:=Sheets(Sheets.Count)
	ActiveSheet.Name = S退避
	ActiveSheet.Visible = False
	'現在位置に戻る
	Application.Goto rg
	'画面描画を再開する
	Application.ScreenUpdating = True
End Sub

使い方

  • 上のコードを、ThisWorkbookに記述する。
  • １回目の保存時には、退避するシートに書式がコピーされる。
  • ２回目の保存時には、退避したシートから書式を復帰してくれる。
  • 書式を変更したい場合は、退避したシートを削除してから作業すればよい。

雑感

  • 複数人で共用するExcelシートは書式がめちゃくちゃになりやすいので、保存するたびに元の状態に復帰してくれるのは助かる。
  • 本来は「条件付き書式」だけを変更できなくするつもりだったのに、書式全体を固定化する方法になってしまった。
  • まあ、条件付き書式があることに気づかず、手動で色を塗ろうとするメンバーもいると思うので、それを防ぐのにもいいかもしれない。
  • 書式を固定化したいシートが２つ以上ある場合については、今度また考えることにする。

Javascript 高階関数を入門してみた map / filter / reduce / some / flatMap

JavaScript ラムダ式 配列

高階関数とは？

  • 引数に関数を受け取る関数のこと（正確な説明だが、初めて聞くとわけがわからない）
  • 高階関数を使うと、配列を処理するときにfor文を使わなくて済む。
  • let i のようなループ用変数を使わず、const変数だけでコードが書けるのが嬉しい！！

2022年現在、高階関数が分からないと時代に取り残されそうな雰囲気なので、さっそく学習を始めることにした。

map：配列の要素を変換する（マッピングする）

【例題】

日付を表す8桁の数値（例：20210819）の配列がある。
これを、日を表す数値（例：19）に変換して配列を出力せよ。

mapを使わない書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
let output = [];
for(let i = 0, z = input.length; i < z; i++){
	const n日 = input[i] % 100;
	output.push(n日);
}
console.log(output); // [19, 20, 30, 31, 1]
mapを使う書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
const output = input.map(elem => {
	const n日 = elem % 100;
	return n日;
});
console.log(output); // [19, 20, 30, 31, 1]

filter：配列の要素を抜き出す（フィルタリングする）

【例題】

日付を表す8桁の数値（例：20210819）の配列がある。
ここから、12月の日付だけを抜き出して配列を出力せよ。

filter を使わない書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
let output = [];
for(let i = 0, z = input.length; i < z; i++){
	const n年月 = input[i] / 100 | 0; // YYYYMM
	const n月 = n年月 % 100;
	if(n月 === 12){
		output.push(input[i]);
	}
}
console.log(output); // [20211230, 20211231]
filter を使う書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
const output = input.filter(elem => {
	const n年月 = elem / 100 | 0; // YYYYMM
	const n月 = n年月 % 100;
	return n月 === 12; // 12月ならtrue
});
console.log(output); // [20211230, 20211231]

reduce：配列を集計して単一の値にする

【例題】

日付を表す8桁の数値（例：20210819）の配列がある。
日を表す数値（例：19）のうち、最大の数値を出力せよ。

reduce を使わない書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
let output = -1;
for(let i = 0, z = input.length; i < z; i++){
	const n日 = input[i] % 100;
	output = Math.max(n日, output);
}
console.log(output); // 31
reduce を使う書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
const output = input.reduce((acc, elem, i, ary) => { // 累積値・各要素・連番・配列自体
	const n日 = elem % 100;
	return Math.max(n日, acc);
}, -1); // 累積値の初期値
console.log(output); // 31
メモ

reduce内の関数は、5回実行される。return結果が次のacc（累積値）となる。
acc（累積値）・elem（各要素）・i（連番）・return結果は、以下の表のようになる。

acc（累積値） elem（各要素） i（連番） return結果
-1 20210819 0 19
19 20210820 1 20
20 20211230 2 30
30 20211231 3 31
31 20220101 4 31

some：ひとつでも該当すれば true を返す

【例題】

日付を表す8桁の数値（例：20210819）の配列がある。
配列の要素が昇順にソートされている場合は true、
昇順にソートされていない場合は false を出力せよ。

some を使わない書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
let output = true;
for(let i = 0, z = input.length; i < z; i++){
	if(i === 0){
		continue;
	}
	if(input[i-1] > input[i]){
		output = false; // 昇順ではない場合、false で処理終了
		break;
	}
}
console.log(output); // true
some を使う書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
const output = ! input.some((elem, i, ary) => { // 各要素・連番・配列自体
	if(i === 0){
		return false;
	}
	return ary[i-1] > elem; // 昇順ではない場合、true で処理終了
});
console.log(output); // true

flatMap：配列の次元を下げて連結する

【例題】

日付を表す8桁の数値（例：20210819）の配列がある。
日を表す数値（例：19）の配列を出力せよ。
ただし、10日、20日、30日の場合は、2つ重複させて出力せよ。

flatMap を使わない書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
let output = [];
for(let i = 0, z = input.length; i < z; i++){
	const n日 = input[i] % 100;
	if(n日 % 10 === 0){
		output.push(n日);
		output.push(n日);
	}else{
		output.push(n日);
	}
}
console.log(output); // [19, 20, 20, 30, 30, 31, 1]
flatMap を使う書き方
const input = [20210819, 20210820, 20211230, 20211231, 20220101];
const output = input.flatMap(elem => {
	const n日 = elem % 100;
	if(n日 % 10 === 0){
		return [n日, n日];
	}else{
		return [n日];
	}
});
console.log(output); // [19, 20, 20, 30, 30, 31, 1]

HTMLタグをHTMLで表示するための変換ツール（文字参照）

HTML

<html>のようなタグを、&lt;html>に変換するツールです。どうぞお使いください。

▼入力欄
　　
▼出力欄（タブ文字はスペース４つに置き換えます）
▼HTMLでの表示のされ方

【はてなブログ】はてな記法で簡単に表を作成するためのツール

はてなブログ

ツールの説明

はてなブログでこのような表を作成するには、

商品名 値段 在庫
アイス 398円 24個
カップ麺 258円 40個

「はてな記法」で以下のように記述します。

|*商品名|*値段|*在庫|
|アイス|398円|24個|
|カップ麺|258円|40個|

はてな記法の表を簡単に作れるツールを作ったので、どうぞお使いください。

表を入力してください


　
▼はてな記法での書き方

追記：大きなテーブルのレイアウトが崩れる場合

大きなテーブルをはてなブログに収めるためには、スクロールできるようにすると良いでしょう。

× 100 500 1000 5000 10000 50000 10000
100 10000 50000 100000 500000 1000000 5000000 10000000
500 50000 250000 500000 2500000 5000000 25000000 50000000
1000 100000 500000 1000000 5000000 10000000 50000000 100000000

<div style="height:150px; width:500px; overflow:scroll">
|×|100|500|1000|5000|10000|50000|10000|
|100|10000|50000|100000|500000|1000000|5000000|10000000|
|500|50000|250000|500000|2500000|5000000|25000000|50000000|
|1000|100000|500000|1000000|5000000|10000000|50000000|100000000|
<div>

VBA マウスポインタの形状を取得する GetCursorInfo / LoadCursor

VBA

やりたいこと

VBAで、マウスポインタが矢印カーソルなのか、待機カーソルなのか知りたい。
待機カーソルになったらVBAの処理を中断、というプログラムを作ろう。

方針

VBAには、Application.Cursor でカーソルの状態を取得することができる。
しかし、これは残念なことに、Excel の外にマウスカーソルが出ると全く機能しない。
Excel の外のマウスポインタの形状を知るには、Win32 API を使う必要がある。

  • マウスカーソルの形状や位置を得るための API ⇒ GetCursorInfo
  • 待機カーソルの番号を得るための API ⇒ LoadCursor


コード（64bit版）

'取得するカーソル情報を保持する構造体
Type CURSORINFO
	nSize As Long '構造体の大きさ(=24)
	nFlag As Long '表示・非表示フラグ
	hCursor As LongPtr 'カーソル画像を表す数値
	x As Long 'X座標
	y As Long 'Y座標
End Type

Const IDC_WAIT = 32514 '待機カーソルのID

'カーソル情報を取得する Win32API 関数
Declare PtrSafe Function GetCursorInfo Lib "user32" (p As CURSORINFO) As Long

'カーソル画像を表す数値を取得する Win32API 関数
Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" ( _
	ByVal hInst As LongPtr, _
	ByVal idc As Long _
) As LongPtr

'処理を一時停止する Win32API 関数
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal nミリ秒 As Long)

Public Sub 今回の処理()
	Dim h待機カーソル As LongPtr
	h待機カーソル = LoadCursor(0, IDC_WAIT) '待機カーソル画像を表す数値を取得
	
	Dim i As Long
	For i = 1 To 100000 'しばらくループする
		Dim カーソル As CURSORINFO
		カーソル.nSize = LenB(カーソル) '構造体の大きさをセット
		GetCursorInfo カーソル 'カーソル情報を取得する
		
		'カーソルの形状が待機になったら、メッセージを表示して終了
		If カーソル.hCursor = h待機カーソル Then
			MsgBox "待機カーソルになりました"
			Exit Sub
		End If
		
		DoEvents 'OSに処理をゆずる
		Sleep(1) '0.001秒待機
	Next
End Sub

補足説明

待機カーソルのIDは 32514 だが、他のカーソルのIDも記載しておく。
参照元：
LoadCursorA function (winuser.h) - Win32 apps | Microsoft Docs

値 意味
IDC_APPSTARTING 32650 標準的な矢印と小さな砂時計
IDC_ARROW 32512 標準的な矢印
IDC_CROSS 32515 十字
IDC_HAND 32649 手
IDC_HELP 32651 矢印とはてなマーク
IDC_IBEAM 32513 Ｉの字
IDC_NO 32648 🚫マーク
IDC_SIZEALL 32646 十字矢印
IDC_SIZENESW 32643 ／の向きの両矢印
IDC_SIZENS 32645 │の向きの両矢印
IDC_SIZENWSE 32642 ＼の向きの両矢印
IDC_SIZEWE 32644 ─の向きの両矢印
IDC_UPARROW 32516 ↑
IDC_WAIT 32514 砂時計

具体的にどのような形状なのかは、以下のリンクが参考になる。
Windowsアプリケーション上のマウス・カーソルを変更するには？［C#、VB］ - ＠IT

VBA Wordに改ページを挿入 Chr(12)

今回やりたいこと

画像の入った Word ファイルがある。
常に画像がページの先頭にくるようにしたい。

そうするには、画像の前に改ページを入れたらいい。

最もシンプルな答え

改ページは Chr(12) の文字で表せる。
画像のRangeを取得して、改ページを InsertBefore で直前に挿入する。

コード

Public Sub 今回の処理()
	Dim o図形 As InlineShape
	For Each o図形 In ActiveDocument.InlineShapes '全ての画像について
		o図形.Range.InsertBefore Chr(12) '前に改ページを挿入
	Next
End Sub

VBA フォルダ内のファイルを再帰的に取得 FileSystemObject

VBA

今回やりたいこと

  • [フォルダ]
    • a.txt
    • b.jpg
    • [子フォルダ]
      • c.html

フォルダの中身がこんな感じだとする。
a や b だけじゃなくて、深い階層にある c のファイルパスも全部取得したい。
そんな関数をつくろう。

関数の仕様

  • フォルダに含まれる全ファイルのパスを取得する。
  • すべてのフォルダ階層を再帰的に探索する。
  • 結果は Collection に入れて返す。

コード

Public Sub テスト実行()
	Dim cファイルパス As Collection
	Set cファイルパス = 全ファイルパスを取得("C:\Windows\Web")
	MsgBox cファイルパス.Count & "個のファイルがあります。"
End Sub

Public Function 全ファイルパスを取得(sフォルダパス) As Collection
	Dim c As New Collection
	全ファイルパスを再帰的に取得 _
		CreateObject("Scripting.FileSystemObject"), c, sフォルダパス
	Set 全ファイルパスを取得 = c
End Function

Private Sub 全ファイルパスを再帰的に取得(fso, c As Collection, sフォルダパス)
	Dim oフォルダ As Object
	Set oフォルダ = fso.GetFolder(sフォルダパス)
	Dim oファイル As Object
	For Each oファイル In oフォルダ.Files
		c.Add oファイル.Path
	Next
	Dim o子フォルダ As Object
	For Each o子フォルダ In oフォルダ.SubFolders
		全ファイルパスを再帰的に取得 fso, c, o子フォルダ.Path
	Next
End Sub

VBA フォルダの全画像をWord文書に挿入 AddPicture

VBA

今回やりたいこと

たくさんある画像ファイルを、Word文書に取り込みたい。
大きすぎる画像ファイルの場合は、文書の横幅に合わせて縮小したい。

でも画像は100以上あるから、とんでもなく面倒だ……
そうだ、Word VBAで自動化しよう。

大まかな方針

  • すべてのJPGファイルを再帰的に取得する => Collectionに入れる
    • 文書の末尾に画像を取り込む
    • 文書の横幅より大きければ縮小する

コード

Option Explicit

Const S_フォルダパス = "C:\Temp" 'ここを変更

Public Sub 今回の処理()
	Dim sファイルパス
	For Each sファイルパス In 全JPGパスを取得(C_フォルダパス)
		Dim o図 As InlineShape
		Set o図 = 画像を文書末尾に挿入(sファイルパス)
		文書横幅に合わせて縮小 o図
		o図.LockAspectRatio = msoTrue '縦横比は固定しておく
	Next
End Sub

Public Function 全JPGパスを取得(sフォルダパス) As Collection
	Dim c As New Collection
	全JPGパスを再帰的に取得 _
		CreateObject("Scripting.FileSystemObject"), c, sフォルダパス
	Set 全JPGパスを取得 = c
End Function

Private Sub 全JPGパスを再帰的に取得(fso, c As Collection, sフォルダパス)
	Dim oフォルダ As Object
	Set oフォルダ = fso.GetFolder(sフォルダパス)
	Dim oファイル As Object
	For Each oファイル In oフォルダ.Files
		Dim s拡張子 As String
		s拡張子 = fso.GetExtensionName(oファイル.Path)
		Select Case UCase(s拡張子)
		Case "JPG", "JPEG"
			c.Add oファイル.Path
		End Select
	Next
	Dim o子フォルダ As Object
	For Each o子フォルダ In oフォルダ.SubFolders
		全JPGパスを再帰的に取得 fso, c, o子フォルダ.Path
	Next
End Sub

Private Function 画像を文書末尾に挿入(sファイルパス) As InlineShape
	Dim rg As Range
	Set rg = ActiveDocument.Bookmarks("\EndOfDoc").Range
	Set 画像を文書末尾に挿入 = rg.InlineShapes.AddPicture(sファイルパス)
End Function

Private Sub 文書横幅に合わせて縮小(o図 As InlineShape)
	Dim n版面幅 As Single
	n版面幅 = 版面幅を取得(o図)
	If o図.Width > n版面幅 Then
		o図.Width = n版面幅
		o図.Height = o図.Height * 版面幅を取得(o図) / o図.Width
	End If
End Sub

Private Function 版面幅を取得(o図 As InlineShape) As Single
	Dim nセクション番号 As Single
	nセクション番号 = o図.Range.Information(wdActiveEndSectionNumber)
	版面幅を取得 = _
		o図.Range.Parent.Sections(nセクション番号).PageSetup. _
		TextColmuns(1).Width
End Function

VBA 正規表現の入門 RegExp

VBA 正規表現

対象者

VBAを使っている人、かつ正規表現を使ってみたい人。

正規表現 (Regular Expression) は何に使うのか

正規表現を使うと、いろんなパターンの文字列を一度に検索することができます。
例えば、

  • 文系の学生
  • 文系の生徒
  • 理系の学生
  • 理系の生徒

の４パターンを(文|理)系の(生徒|学生)と検索できるので、４回検索する手間を１回に節約できます。
正規表現を覚えると、もう、正規表現なしで文字列を検索することは無くなります……というのは大げさですが、それくらい便利です。


正規表現のはじめかた

  1. ツールバーから、[ツール]>[参照設定]
  2. 参照設定から、[Microsoft VBScript Regular Expressions 5.5]>[OK]

コードには以下のように記述してください。

Const s文章 = "３年理系の生徒は手続きをしてください。" '検索対象

Dim rx As New RegExp
rx.Patten = "(文|理)系の(学生|生徒)"    '検索パターン

If rx.Test(s文章) Then
	MsgBox "合致しました"    '※今回は合致する
Else
	MsgBox "合致しませんでした"
End If

文章を変えながら、パターンに合致するか試してみましょう。

文法レベル1

最も理解しやすいものから順に解説します。

指定した文字列のどれかに合致
  • 野いちご
  • 野イチゴ
  • 野苺

野(いちご|イチゴ|苺)
それぞれの文字列を | で区切って、( ) で囲みます。

指定した文字の内のどれか（１文字）
  • タイプA
  • タイプB
  • タイプC

タイプ[ABC]
文字を並べて [ ] で囲みます。

文字列があってもなくてもいい
  • 生鮮売場担当者
  • 生鮮担当者

生鮮(売場)?担当者
あってもなくてもいい文字列を ( と )? で囲みます。

文字があってもなくてもいい（１文字）
  • お代官様
  • お代官
  • 代官様
  • 代官

お?代官様?
あってもなくてもいい文字の後ろに ? をつけます。

なんでもいい１文字
  • かつら
  • かしら
  • かめら

か.ら
なんでもいい１文字は . （ドット）で表せます。

指定した文字以外なら、なんでもいい
  • 山田太郎
  • 山田次郎 ※これは除外
  • 山田三郎 ※これは除外
  • 山田四郎

山田[^次三]郎
除外したい文字を [^ と ] で囲みます。

数字１文字なら、なんでもいい
  • 4番線
  • 6番線
  • 8番線

\d番線
数字１文字は \d で表します。
d はデジタルの d でしょうか。

A～Z なら、なんでもいい
  • Aランク
  • Fランク
  • Zランク

[A-Z]ランク
文字の範囲指定は [x-y] のように書きます。

何回くりかえしてもいい
  • Aランク
  • AAランク
  • AAAAAランク
  • ランク

A*ランク
何回くりかえしてもいい（0回もOK）場合は * を使います。

何回くりかえしてもいい（１回以上）
  • Aランク
  • AAランク
  • AAAAAランク
  • ランク ※これは除外

A+ランク
何回くりかえしてもいい（0回はダメ）場合は + を使います。

文法レベル2

～で始まり～で終わる
  • 最強勇者の俺が錬金術師にジョブチェンジした件について
  • 最強勇者の俺が転生したら皆が最強勇者だった件について
  • 最強勇者の爺様が大魔王から好かれすぎて限界な件について
  • 最強勇者の件について

最強勇者の.*件について
「最強勇者の」と「件について」の間は、なんでもいい文字 ( . ) を何回くりかえしてもいい ( * ) ということです。

アルファベットや数字なら何でもいい
  • Aキー
  • 8キー
  • yキー

[A-Za-z0-9]キー
文字の範囲指定 [x-y] は、複数まとめて書くことができます。

n回くりかえす
  • アアイアア
  • アイウアイ
  • ウイイウア

[アイウ]{5}
アイウをくりかえしている回数5を { } で囲みます。

n回以上くりかえす
  • 1234567890
  • 31415926
  • 223609

\d{6,}
6回やそれ以上の場合、6の後ろにカンマが入ります。

n回以下くりかえす
  • 背番号
  • 背番号5
  • 背番号777

背番号\d{,3}
3回やそれ以下の場合、3の前にカンマが入ります。
1～3回くりかえす場合は、{1,3} と書きます。

特殊な文字と合致

( | ) ? . [ ] * + { } \ ^ $ といった文字は、正規表現の条件を表すために使われる特殊な文字です。

  • 温泉(男湯)
  • 温泉(女湯)
  • 温泉(混浴)
  • 温泉(露天)

温泉\(..\)
( を検索するには、\( と書きます。同様に、? を検索するには \? と書きます。他の文字も同じように \ を前につけます。

合致した文字列から一部を取り出す (サブマッチ)

このようなログがあるとします。

  • 製造年月:2022/05, ID:1242531_JP, 検品済

ここからIDの部分を検索して、

  • ID:1242531_JP

(数値n桁) と (国名アルファベットn桁) を取り出したいと思います。
取り出したい部分（数値と国名）をカッコで囲んで正規表現を作ります。
ID:(\d+)_([A-Z]+)
そして、次のようなVBAのコードを書きます。

Const s文字列 = "製造年月:2022/05, ID:1242531_JP, 検品済"    '検索対象

Dim rx As New RegExp
rx.Patten = "ID:(\d+)_([A-Z]+)"    '検索パターン

Dim s数値 As String
Dim s国名 As String

Dim m As Match
For Each m In rx.Execute(s文字列)    '検索を実行して、結果をmに取り出す
	s数値 = m.SubMatches(0)    '0番のサブマッチ(\d+)
	s国名 = m.SubMatches(1)    '1番のサブマッチ([A-Z]+)
Next
MsgBox "数値=" & s数値 & " , " & "国名=" & s国名    '数値=1242521 , 国名=JP

正規表現の中で ( ) に囲まれた部分は、m.SubMatches(n) で取り出せます。
Sheets(n) などと異なり、連番が0から始まるので注意です。

文法レベル3

できるだけ短い合致を探せ / できるだけ長い合致を探せ

ここにHTMLのタグがあります。

  • <body><a href="URL">リンクはこちら</a>本文......

最初に出現したタグ <body>を取り出したいと思います。正規表現は以下のようになります。
<.+?>
+? というのは、「できるだけ短く合致する箇所を探せ」という意味です。控え目ですね。

今までのように単純に + を使って検索すると…
<.+>

  • <body><a href="URL">リンクはこちら</a>本文......

ここが選ばれてしまいます。
+ というのは、「できるだけ長く合致する箇所を探せ」という意味だったのです。欲張りですね。
控え目な方が処理も軽いので、目的に沿っていれば +? を使っていきましょう。

行頭と行末

行の中に「～円」以外に余計なものが入っていないものを選びたいと思います。

  • 880円
  • 1410円
  • 1980円です。 ※これは除外
  • 合計：2320円 ※これも除外

^\d+円$
^ は「ここが行頭になる」という意味です。
$ は「ここが行末になる」という意味です。

指定した文字列以外なら、なんでもいい
  • 山田昭雄
  • 山田一郎 ※これは除外
  • 山田梅子
  • 山田エリザベス

山田(?!一郎).+
この位置に 一郎 が来るのは許さない、という意味です。
「否定先読み」という名前で呼ばれています。

指定した文字列は、存在してはならない
  • 山田・ベスト・昭雄 ※これは除外
  • 鈴木一郎
  • 佐藤梅子
  • 斎藤・エリザベス ※これも除外

^(?!.*ベス).+
先頭から調べていき ( ^ )、
～ベス が来るのは許さない、という意味です。

先頭の ^ がない場合、ベ の次の文字から選ばれてしまいます。

  • 山田・ベスト・昭雄
  • 斎藤・エリザベス

VBAで置換処理

このようなログがあるとします。

  • 開始日：2022年6月4日 土曜日
  • 完了日：2022年6月5日 日曜日

これを次のように置換処理したいと思います。

  • 開始=22/6/4
  • 終了=22/6/5

コードは以下のようになります。

Const s文字列 = "開始日：2022年6月4日 土曜日" & vbCrLf _
              & "終了日：2022年6月5日 日曜日"          '検索対象

Dim rx As New RegExp
rx.Patten = "^(開始|終了)日：\d\d(\d\d)年(\d+)月(\d+)日"    '検索パターン
rx.Global = True    '文字列全体を対象に検索するには、Trueにする

MsgBox rx.Replace(s文字列, "$1=$2/$3/$4")    'サブマッチ$1～4を置換処理に使う

rx.Pattern のからくりは以下のようになっています。

^(開始|終了)日：\d\d(\d\d)年(\d+)月(\d+)日開始日：2022年6月4日 土曜日

^(開始|終了)日：\d\d(\d\d)年(\d+)月(\d+)日開始日：2022年6月4日 土曜日

^(開始|終了)日：\d\d(\d\d)年(\d+)月(\d+)日開始日：2022年6月4日 土曜日

rx.Replace(s文字列, "$1=$2/$3/$4") は、第１引数の文字列の合致部分を、第２引数で置き換えます。
第２引数には、$1 などが入っており、これは以下のようなルールで置き換えられます。

  • $1 ← 0番のサブマッチ(開始)
  • $2 ← 1番のサブマッチ(22)
  • $3 ← 2番のサブマッチ(6)
  • $4 ← 3番のサブマッチ(5)

したがって、$1=$2/$3/$4 は 開始=22/6/5 に置換されます。

rx.Global = True は、「文章全体を対象に検索や置換処理を行う」という意味です。
デフォルトでは False です。これでは、最初に見つけた箇所しか置換処理をしてくれません。
2022年6月4日 だけではなく、2022年6月5日 のログも処理してほしいので True にします。

おわりに

正規表現で文字列処理をできるようになると、同様の処理を自分で実装したときに、コーディングの長さが何倍にもなることに気づくと思います。（したがってバグの数も……）
正規表現はVBAだけでなく、他のあらゆる言語で使えます。使い勝手はちょっと違いますが、学んだことは色あせません。
どんどん活用していきましょう。

VBAの可変長配列 Collection / ReDim Preserve

VBA

要点

  • VBAで、要素を追加すると伸長する配列みたいなものといえば、Collectionです。
  • 配列のメモリ再割り当てReDim Preserveを使っても、可変長の配列を実現できます。面倒だけど動作は速い。

線形リスト Collection

Collectionは線形リストです。以下のようなコードで簡単に要素を追加・アクセス・削除できます。

Dim c果物 As New Collection

c果物.Add "りんご"    '要素の追加
c果物.Add "みかん"
c果物.Add "バナナ"

Debug.Print c.果物(1)    'りんご ※要素の番号は1から始まる
Debug.Print c.果物(2)    'みかん
Debug.Print c.果物(3)    'バナナ

c果物.Remove 2    'みかんを削除
弱点１：書き換えができない

大変不便なことに、各要素を書き換えることができません。罠です。

c果物(2) = "オレンジ"    '※できません。
'    ↓ 消してから追加するしかない…
c果物.Remove 2
c果物.Add "オレンジ", After:= 1
弱点２：後ろの方のアクセスがやや遅い

線形リストの特徴ですが、前から順番に要素を辿らないといけないので、後ろの方の要素のアクセスが遅いです。
万単位の要素数の場合には無視できなくなります。逆に、千単位の要素数なら速度の違いは無視していいです。
For Eachを使って前から順次にアクセスする場合には、後ろでも遅くなりません。

Dim c巨大 As New Collection    '巨大なリスト（1～20000を入れる予定）
Dim i As Long
For i = 1 To 20000
    c巨大.Add i
Next

Dim n合計 As Long    '全要素を合計する
Dim n
For Each n In c巨大
    n合計 = n合計 + n
Next

Debug.Print n合計    '200010000

遅いバージョン(Forを使う)

Dim c巨大 As New Collection    '巨大なリスト（1～20000を入れる予定）
Dim i As Long
For i = 1 To 20000
    c巨大.Add i
Next

Dim n合計 As Long    '全要素を合計する
Dim j As Long
For j = 1 To 20000
    n合計 = n合計 + c巨大(j)
Next

Debug.Print n合計    '200010000

配列メモリの再割り当て ReDim Preserve

普通の配列では、要素の追加はできません。ReDim Preserveを使えば、メモリを再割り当てして可変長を実現できます。

Dim a果物(1 To 3) As String    '要素3つの配列
a果物(1) = "りんご"
a果物(2) = "みかん"
a果物(3) = "バナナ"    '使えるのは、3番目まで

ReDim Preserve a果物(1 To 5) As String    '中身を保ったまま拡張
a果物(4) = "いちご"
a果物(5) = "メロン"    '5番目まで使えるようになった
拡張するなら倍の長さで

要素を追加する度にReDim Preserveで拡張すると、動作が遅くなります。
配列がすべて埋まったら、思い切って倍の長さを確保しましょう。

Dim a配列(1 To 100) As Long   '容量100の整数配列（1～10000を入れる予定）
Dim n配列長 as Long    '配列の実際の長さも保持しておく（初期値＝0）

Dim i as Long
For i = 1 To 10000
    n配列長 = n配列長 + 1
    If n配列長 > UBound(a配列) Then    '長さが足りなくなったら、倍の長さに拡張
        ReDim Preserve a配列(1 To UBound(a配列) * 2)
    End If

    a配列(n配列長) = i
Next
ReDim Preserve a配列(1 To n配列長)    '最後に余った部分を切り落としたら出来上がり

余談：1から始まるインデックス

VBAでセルを配列として取得すると、最初の要素が「1番目」になります。

Dim a
a = Range("A1:B3").Value

Debug.Print a(1, 1)    'A1は a(0, 0) じゃないよ
Debug.Print a(1, 2)    'A2
Debug.Print a(1, 3)    'A3
Debug.Print a(2, 1)    'B1
Debug.Print a(2, 2)    'B2
Debug.Print a(2, 3)    'B3

普通に配列を作ると、0番目から要素が始まってしまい、セル配列や Collection と規則が違うのが気持ち悪いですね。
個人的には、1から始まるように配列を作ることにしています。

Dim a(3) As String    'a(0), a(1), a(2)
Dim a(1 To 3) As String 'a(1), a(2), a(3) ←これすき

VBA これがあれば戦える！実務でよく使う処理TIPS一覧

VBA

概要

  • VBAでよく使うものをまとめた個人的なメモ
  • コード中に出てくるプレフィックスの意味
    • n: 整数
    • s: 文字列
    • b: True/False
    • t: 日付・時刻
    • v: Variant
最初にすること
Option Explicit	' Dimなしに変数を使うことは許可しない
Collection（可変長リスト）
Set c = New Collection
c.Add v要素		' v要素を末尾に追加
c.Add v要素, , n通番	' n通番の前にv要素を挿入
c.Remove n通番		' n通番を削除
c.Count			' 要素の数 => n
For Each v要素 In c	' 全てのv要素に対して操作

c(n通番) = v要素 ' n通番にv要素を代入することは「できない」

Dictionary（連想配列）
Set d = CreateObject("Scripting.Dictionary")
d(vキー) = v値		' vキーに対応するv値を代入
d.Add vキー, v値		' vキーとv値の組を追加
d.Remove vキー		' vキーを削除
d.Count			' 要素の数 => n
d.Exists(vキー)		' vキーの存在を確認 => b
For Each vキー In d	' 全てのvキーに対して操作
エラー処理
Function エラー処理例()
    On Error Goto E	' エラー発生時にラベルにジャンプ
    n = n / 0		' エラー発生！
E:			' ラベル
    MsgBox "ゼロ除算"	' エラー処理
End Function
分岐の短縮表現
IIf(b式, v成立時, v非成立時)		' b式の真偽で結果を分岐 => v
Choose(n式, v結果1, v結果2, v結果3, ...)	' n式の値で結果を分岐 => v
文字列
Len(s)				' 文字列の長さ => n
Left(s, n長さ)			' 文字列を左から切り出す => s
Mid(s, n開始)			' 文字列を途中から切り出す => s
Mid(s, n開始, n長さ)		' 文字列を途中から途中まで切り出す => s
Mid(s, n開始) = s置換		' 文字列を途中から置き換える
Right(s, n長さ)			' 文字列を右から切り出す => s
InStr(s全体, s部分)		' s全体の中でs部分が出現した箇所 => n
InStr(n開始, s全体, s部分)	' n開始より後ろから調べる => n
Format(v, s形式)		' vをs形式に従って文字列に変換する => s
'└ s形式の例: "yyyymmdd" , "hhnnss" , "0000", "###,##0.00"
Asc(s)				' sの先頭文字のコードを取得 => n
Chr(n文字コード)			' n文字コードに対応する文字を取得 => s
Val(s)				' sを数値に変換する => n
IsNumeric(s)			' sが数値か判定 => b
LTrim(s)			' 左側の空白ではない文字から切り出す => s
RTrim(s)			' 右側の空白ではない文字から切り出す => s
Trim(s)				' LTrim と RTrim => s
LCase(s)			' 大文字を小文字にする => s
UCase(s)			' 小文字を大文字にする => s
StrComp(s1, s2)			' s1とs2を比較 => -1, 0, 1
Space(n)			' n個の空白を生成 => s
String(n, 0)			' 指定の長さのNULL文字列を確保 => s
高速に大量の文字列連結をする関数
Function 連結(s As String, n長さ As Long, s追加 As String)
    Dim n長さ0 As Long: n長さ0 = n長さ
    n長さ = n長さ + Len(s追加)
    If n長さ > Len(s) Then
	s = s & String(n長さ \ 2, 0)
    End If
    Mid(s, n長さ0 + 1) = s追加
End Function

' 関数の使い方
Dim s As String, n長さ as Long	' 作業用文字列と長さが必要
連結 s, n長さ, "あいう"		' s(長さ0)に「あいう」を連結
連結 s, n長さ, "えお"		' s(長さ3)に「えお」を連結
連結 s, n長さ, "かきく"		' s(長さ5)に「かきく」を連結
s = Left(s, n長さ)		' 8文字だけ切り出す
日付
Date				' 今日の日付 => t
DateSerial(n年, n月, n日)	' 日付を生成する => t
Year(t)				' 年を取得する => n
Month(t)			' 月を取得する => n
Day(t)				' 日を取得する => n
Time				' 現在時刻 => t
TimeSerial(n時, n分, n秒)	' 時刻を生成する => t
Hour(t)				' 時を取得する => n
Minute(t)			' 分を取得する => n
Second(t)			' 秒を取得する => n
Now				' 現在の日付時刻 => t
DateAdd(s単位, n, t)		' tをs単位でn進める => t
DateDiff(s単位, t1, t2)		' t1-t2をs単位で求める => n
' └ s単位の例: "yyyy", "m", "d", "h", "n", "s"
FileSystemObject（ファイル・フォルダ共通の処理）
With CreateObject("Scripting.FileSystemObject")
.GetBaseName(sパス)		' 拡張子ぬき名前を取得 => s
.GetExtensionName(sパス)	' 拡張子を取得 => s
.GetFileName(sパス)		' 拡張子つき名前を取得 => s
.GetParentFolderName(sパス)	' 親フォルダのパスを取得 => s
End With
FileSystemObject（ファイルの操作）
With CreateObject("Scripting.FileSystemObject")
.CopyFile s元, s先				' コピー
.MoveFile s元, s先				' 移動
.DeleteFile sパス				' 削除
.FileExists(sパス)				' ファイルの存在確認 => b
.CreateTextFile(sパス, [b上書き, bユニコード])	' 作成 => TextStream
.OpenTextFile(sパス, [モード, bない場合作成])	' 開く => TextStream
' └ モード: ForReading(読込), ForWriting(書込), ForAppending(追記)
.GetFile(sパス)					' ファイルを取得 => File
End With
File（ファイルの情報）
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.GetFile(sパス)
.DateCreated		' 作成日時 => t
.DateLastAccessed	' 最終アクセス => t
.DateLastModified	' 最終更新 => t
.Path			' パス => s
.ParentFolder		' 親フォルダを取得 => Folder
.Size			' バイト数 => n
.Type			' ファイルの種類 => s
End With
FileSystemObject（フォルダの操作）
With CreateObject("Scripting.FileSystemObject")
.CreateFolder sパス	' 作成
.CopyFolder s元, s先	' コピー
.MoveFolder s元, s先	' 移動
.DeleteFolder sパス	' 削除
.FolderExists(sパス)	' フォルダの存在確認 => b
.GetFolder(sパス)	' フォルダを取得 => Folder
End With
Folder（フォルダの情報）
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.GetFolder(sパス)
.Files			' フォルダ内の全ファイル => Collection
.SubFolders		' フォルダ内の全フォルダ => Collection
.IsRootFolder		' フォルダがルートか判定 => b
.DateCreated		' 作成日時 => t
.DateLastAccessed	' 最終アクセス => t
.DateLastModified	' 最終更新 => t
.Path			' パス => s
.ParentFolder		' 親フォルダを取得 => Folder
.Size			' バイト数 => n
.Type			' ファイルの種類 => s
End With
TextStream（ファイル読み書き）
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.CreateTextFile(sパス)
.Read(n文字数)	' n文字数だけ読み進める => s
.ReadAll	' 最後まで読み進める => s
.ReadLine	' 行末まで読み進める => s
.Write s	' sを書き込む
.WriteLine	' 改行を書き込む
.WriteLine s	' sと改行を書き込む
.AtEndOfLine	' 行末に到達したことを判定 => b
.AtEndOfStream	' ファイル終端に到達したことを判定 => b
.Line		' 現在のカーソル行 => n
.Column		' 現在のカーソル列 => n
.Skip n文字数	' n文字数だけ読み飛ばす
.SkipLine	' 行末まで読み飛ばす
End With
ワークブック
Set book = Workbooks.Open(sパス)	' ブックを開く => Workbook
Set book = Workbooks.Add		' 新規のブック => Workbook
Set book = Workbooks(sブック名)		' 既に開いたブック => Workbook
Set book = ActiveWorkbook		' 現在のブック => Workbook
With book
.Path		' ブックのあるフォルダ
.Name		' ブック名(拡張子つき)
.Worksheets	' ブックに含まれる全シート => Collection
.Save		' 保存
.SaveAs sパス	' 別名で保存
.Close		' 閉じる
End With
ワークシート
Set sheet = Worksheets.Add		' 新規のシート => Worksheet
Set sheet = Worksheets(sシート名)	' 指定のシート => Worksheet
Set sheet = Worksheets(n通番)		' 指定のシート => Worksheet
Set sheet = ActiveSheet			' 現在のシート => Worksheet
With sheet
.Copy			' 新しいブックにコピー => Worksheet
.Copy(Before:=sheet)	' sheetの前にコピー => Worksheet
.Copy(After:=sheet)	' sheetの後にコピー => Worksheet
.Move			' 新しいブックに移動 => Worksheet
.Move Before:=sheet	' sheetの前に移動
.Move After:=sheet	' sheetの後に移動
.Name = sシート名	' シート名を設定
.Delete			' 削除
End With
セルの取得
Set sheet = ActiveSheet
With sheet
Set rg1 = .Range("A1")		' A1のセル => Range
Set rg2 = .Cells(n行, n列)	' (n行,n列)のセル => Range
.Range("A1:D2")			' A1:D2のセル範囲 => Range
.Range(rg1, rg2)		' rg1とrg2を端とするセル範囲 => Range
.Rows(n行)			' n行すべて => Range
.Columns(n列)			' n列すべて => Range
rg1.Offset(n下, n右)		' (n下,n右)ずれたセル範囲 => Range
rg1.EntireRow			' rg1を含む行全体 => Range
rg1.EntireColumn		' rg1を含む列全体 => Range
rg1.Resize(1, 1)		' rg1の左上のセル => Range
rg1.Resize(n縦, n横)		' rg1の大きさを変更した範囲 => Range
rg1.End(方向)			' Ctrl+方向で移動するセル => Range
' └ 方向: xlUp, xlDown, xlToLeft, xlToRight
.UserdRange			' シートで使われている範囲 => Range
End With
セルに対する操作
With ActiveSheet.Range("A1")
.Value = s		' 内容を設定
.Formula = s		' 数式を設定
.Clear			' 削除
.ClearContents		' 削除(書式は残る)
.RowHeight = n		' 行の高さを設定
.ColumnWidth = n	' 列の横幅を設定
.AutoFit		' セルの内容に合わせて行と列を拡張する
.Copy			' クリップボードにコピー
.Copy range先		' コピペ
.Address		' このセルの位置($A$1など) => s
End With
セルの書式設定
With ActiveSheet.Range("A1")
.Font.Color = RGB(n赤, n緑, n青)			' 文字色
.Font.Bold = b					' 太字
.Font.Italic = b				' 斜体
.Font.Size = n					' 文字サイズ
.Font.Underline = 下線形式			' 下線
' └ 下線形式: xlUnderlineStyleNone, StyleSingle, StyleDouble
.Font.Name = s					' フォント名
.Interior.Color = RGB(n赤, n緑, n青)		' 背景色
.Borders.LineStyle = 罫線の種類			' 範囲を囲む罫線
' └ 罫線の種類: xlNone, xlContinuous, xlDouble, xlDash, xlDot
.Borders(罫線の位置).LineStyle = 罫線の種類	' 特定の罫線
' └ 罫線の位置: xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight
.Borders.Color = RGB(n赤, n緑, n青)		' 罫線の色
.Borders.Weight = 罫線の太さ			' 罫線の太さ
' └ 罫線の太さ: xlHairLine, xlThin, xlMedium, xlThick
End With
セルの表示形式
With ActiveSheet.Range("A1")
.NumberFormatLocal = 書式
' └ 標準: G/標準
' └ 数値: 0_
' └ 日付: yyyy/mm/dd
' └ 時刻: hh:mm:ss
' └ 百分率: 0.00%
' └ 分数: # ?/?
' └ 指数: 0.E+00
' └ 文字列: @
End With
動作高速化
Application.ScreenUpdating = b	' 画面の更新を有効,無効にする
With ActiveSheet.Range("A1").Resize(n行数, n列数)
.Value = a二次元配列		' 二次元配列を１回で書き込む
End With
二次元配列
Dim a二次元配列() As String
ReDim a二次元配列(1 To n行数, 1 To n列数)	' 行数と列数を指定して配列を作成
a二次元配列(n行, n列) = s		' 代入する
ソート
With ActiveSheet
Set rg = Cells(n行, n列)		' 整列範囲の左上端
.Sort.SortFields.Clear			' 整列方法を初期化
.Sort.SetRange rg.Resize(n縦, n横)	' 整列範囲を設定
.Sort.SortFields.Add _
    Key:=rg.Offset(0, n基準列), _	' 整列の基準列を設定
    Order:=昇順・降順			' xlAscending/xlDescending
.Sort.Header = xlNo			' 範囲にヘッダ行は含まない
.Sort.Apply				' 整列の実行
End With
他のプログラムの実行
nID = Shell(sコマンド, 状態)		' sコマンドを実行する/タスクID => n
' └ 状態: vbHide, vbNormalFocus, vbMinimizedFocus, vbMaximizedFocus
' └     : vbNormalNoFocus, vbMinimizedNoFocus
AppActivate nID				' プログラムをアクティブにする
AppActivate sタイトル			' プログラムをアクティブにする
Shell "Explorer.exe " + sパス		' フォルダを開く
Shell "Explorer.exe /select," + sパス
SendKeys sキー文字列 b待機		' 文字を自動入力する
' └ 特殊文字: {BS}{DEL}{ENTER}{ESC}{UP}{LEFT}{DOWN}{RIGHT}{TAB}{F1}
' └         : Shift +(abc) , Ctrl ^v , Alt %{F4}
Application.Wait DateAdd("s", n, Now)	' n秒停止する
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText s: .PutInClipboard		' クリップボードにsをコピー
End With
待機中に応答可能にする関数
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal n As Long)
Function 待機(n秒)
    Dim t終了 = DateAdd("s", n, Now)
    Do While t終了 > Now
        DoEvents
        Sleep(15)
    Loop
End Function
正規表現
With CreateObject("VBScript.RegExp")
.Pattern = s					' パターン
.Global = b					' 全体から検索
.IgnoreCase = b					' 大文字小文字同一視
For Each match In .Execute(s)			' 全ての一致に対して操作
    match.FirstIndex				' 先頭の位置
    match.Length				' 長さ
    match.Value					' 文字列
    For Each sサブ一致 In match.SubMatches	' 全てのサブ一致に対して
        MsgBox sサブ一致
    Next
Next
End With
正規表現ヒント
\d \D \s \S .		' 数字・数字以外・空白・空白以外・改行以外
* + ?			' 0回以上・1回以上・0回か1回（最長一致）
*? +? ??		' （最短一致）
{n} {n,m} {n,}		' n回・n～m回・n回以上
^ $			' 行頭・行末
[abc] [a-z] [^xyz] .	' abcどれか・a～zどれか・xyz以外の何か
\w \W			' [a-zA-Z0-9_]・それ以外
pro(ject|gram)		' projectかprogram
vb(?=a)			' vbaを見つけた時のvb
vb(?!s)			' vb_を見つけた時のvb、ただしvbsはダメ
\1 \2 \3		' １番目・２番目・３番目サブ一致
$1 $2 $3		' １番目・２番目・３番目サブ一致（Replace用）
$_ $& $` 		' 入力文字列・一致文字列・一致より前方（Replace用）

Rust スレッドの実行結果を受け取る join, unwrap_or

Rust

概要

スレッド終了時に実行結果を受け取るには「join().unwrap_or(...)」を使う。

プログラム例
  • 本スレッドから別スレッドに数値を渡す。
  • 別スレッドでは、10000÷数値 の計算式の文字列を作る。
  • これを本スレッドに渡す。
use std::thread::{spawn, sleep};
use std::time::{Duration};

fn main() {
    let 入力 = 123;
    let 別スレッド = spawn(move || {
        sleep(Duration::from_millis(1000));    // 1秒待つ。
        format!("10000÷{}={}", 入力, 10000 / 入力)    // セミコロンなし。
    });
    let 出力 = 別スレッド.join().unwrap_or("異常終了".to_string());
    println!("{}", 出力);
}
解説
  • 別スレッドの結果は、セミコロン (;) を付けなかった最後の文を実行した結果になる。
  • unwrap_or(...)を使うと、スレッドの成功時と失敗時の両方に対応できる。
  • 成功時には "123×10=1230" が得られ、失敗時には "異常終了" が得られる。
  • この例で異常終了させるには、入力に 0 を指定すればよい。（ゼロ除算）

◆Rust 入門してみた TOP に戻る◆