t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

VBA オブジェクト変数の宣言時にNewすると何がまずいのか

VBAの研究・考察 VBA VBAについての考え・意見 クラスモジュール活用

オブジェクト変数の宣言と使用については、以下の2パターンが存在する。

■パターン1 宣言と同時にNewしてしまう方法
Dim C As New Collection

■パターン2 宣言とオブジェクトのSetを分ける方法
Dim C As Collection
Set C = New Collection

私はこれまで大体のケースでパターン1を用いてきた。そのほうがコードが短くまとまってスッキリするからだ。

たかが1行とあなどるなかれ。1つのプロシージャのサイズはスクロールせずに全体が見渡せるくらいの長さが理想的であるが、特にノートPCのように画面が狭い環境では1行といえど貴重なスペースである。

ところがちょうど今日、VBAのお膝元であるMicrosoftのサイトでVB6.0においては変数宣言時にNewするのは避けるべきであるとの記述を発見してしまった。

https://msdn.microsoft.com/ja-jp/library/dd297716.aspx

VBAも実質はVB6.0なのでもちろんこれに該当する。

短く書けなくなるのは残念であるが、MSの公式見解である以上は方針転換を検討せざるを得ない。

そもそも変数宣言でNewした場合の動作について

前述のページには「Visual Basic 6.0 では、このコードのある行ではオブジェクトは生成されずに、それを利用するタイミングに、オブジェクトがすでに作られているかどうかをチェックし、なければ作成されるというものでした。これによる利点と欠点は次の通りです。」とある。

まぁここまでは知っていた。
驚いたのはここからで、「必ずオブジェクトが存在することが保証される (Nothing を設定してオブジェクトが破棄されたとしても、オブジェクト変数を再利用しようとすると、再作成される)」という記述である。

実際にやってみた。

Sub あれれー()
    Dim C As New Collection
    Set C = Nothing
    C.Add "あれ？なんでNothing入れたのにAddできるん？"
    MsgBox C.Item(1)
End Sub

マジだ。

オブジェクトを明示的にNothingで破棄しているにもかかわらず、C.Addができてしまう。

ちなみに、念のため宣言とNewを分けて書いてみたところ、エラーになる。これは予想どおり。

Sub こっちはエラーになる()
    Dim C As Collection
    Set C = New Collection
    Set C = Nothing
    C.Add "このAddは無理"
    MsgBox C.Item(1)
End Sub

さて、この実験により変数宣言時にNewするとオブジェクト変数にNothingを設定しても、そのオブジェクト変数を再利用しようとすると自動でオブジェクトが生成されてしまうことが判明した。

ところで、オブジェクトの利用とはプロパティの設定やメソッドの実行だけを指しているのではない。単にオブジェクト変数を参照するだけで利用したことになってしまうのだ。

以下のコードはオブジェクト変数にNothingを代入しているにも関わらず、Nothingと比較するとFalseになってしまうというもの。

Sub Nothingになってくれない()
    Dim C As New Collection
    
    Set C = Nothing
    Debug.Print C Is Nothing
    
    Set C = Nothing
    Debug.Print C Is Nothing
End Sub

Set C = Nothingの時点ではちゃんとNothingが入っているけど、いざ比較しようとしたらやはりオブジェクト変数の中身を参照する必要があるので、その時点で中身が作られてしまいNothingではなくなってしまうのだ。

つまりCはNothingになるけれど、観測した瞬間Nothingではなくなってしまう。なんだか量子力学にでてくるシュレーディンガーの猫の話と似てる。まぁ、VBAの場合はローカルウインドウを使えばちゃんとNothingになっている瞬間を観測できるけどね。

オーバーヘッドについて

変数宣言するときにNewした場合、オブジェクト変数が参照されるたびにNothingかどうかをチェックするのでオーバーヘッドが発生する。
MSDNには変数宣言時にNewする方法について、「オーバーヘッドが大きいので、使うべきではありません。」と書かれているが、はたしてどれくらい違うものなんだろうか。

実際にやってみた。

Sub 変数宣言とNewを分ける()
    t = Timer
    Dim C As Collection
    Set C = New Collection
    For i = 1 To 10000000
        C.Add i
    Next
    Debug.Print Timer - t
End Sub

Sub 変数宣言と同時にNew()
    t = Timer
    Dim C As New Collection
    For i = 1 To 10000000
        C.Add i
    Next
    Debug.Print Timer - t
End Sub

結果は、大して変わらない。
いちおう変数宣言とNewを分けた書き方の方が早かった。
とはいえ、1000万回ループさせてやっと有意差が0.3～0.4秒なのでオーバーヘッドによる遅延は微々たるものだ。

変数宣言時にNewするとコンストラクターの発動タイミングが変わる。

実はDim C As New Collectionが実行されたタイミングではまだCにはCollectionが入っていない。
実際にCollectionが変数に格納されるのは、一度でもそのオブジェクト変数が利用されたときだ。

まぁ有名な話なので知ってる人は知ってると思うが、ここで今一度実験によってその挙動を明らかにしておきたい。
調査するためには、Collectionでは分かりにくいので自作のクラスにコンストラクターを実装して確認してみよう。

コンストラクターとは、オブジェクトが生成されたタイミングで自動的に発動される特殊なプロシージャである。

クラスモジュールClass1を作成し、次のコードを張り付ける。

Private Sub Class_Initialize()
    Debug.Print "オブジェクトが生まれました。"
End Sub

Sub hoge()
    Debug.Print "hoge"
End Sub

次に標準モジュールのコード

まずはMicrosoftの推奨する方法で行儀よく。

Sub 宣言とNewを分けた場合()
    Dim c As Class1
    Debug.Print "標準コード1"
    Set c = New Class1
    Debug.Print "標準コード2"
    c.hoge
End Sub

結果はこうなった。

標準コード1
オブジェクトが生まれました。
標準コード2
hoge

ちゃんとNew Class1とした瞬間にオブジェクトが生まれている。

では次に変数宣言時にNewした場合。

Sub 宣言時にNewした場合()
    Dim c As New Class1
    Debug.Print "標準コード1"
    c.hoge
End Sub

結果は以下のとおり。

標準コード1
オブジェクトが生まれました。
hoge

ほら、宣言時のNewではオブジェクトが生成されておらず、次の標準コード1が表示されている。
そしてc.hogeと命令を出した瞬間、命令よりも一瞬早くコンストラクターのコードが実行される。

次に、メソッドの実行などを行わずにオブジェクト変数の参照だけするケース。
変数のアドレスを調べるVarPtr関数を使ってみた。
ザ・参照！って感じの関数なのでちょうど良いかと思って。

Sub 宣言時にNewしたのち参照だけした場合()
    Dim c As New Class1
    Debug.Print "標準コード1"
    Debug.Print VarPtr(c)
    Debug.Print "標準コード2"
    c.hoge
End Sub

結果は次のとおり

標準コード1
オブジェクトが生まれました。
 3141520 
標準コード2
hoge

この場合も、初めて参照されたタイミングでコンストラクターが実行されている。

オブジェクト変数の宣言時にNewしたことで発生しうるバグ

まあ、変数宣言時にNewしたからといってそれが原因で起こるバグというのはあまり考えにくいのだけれど、そこはあえてバグが起きるコードを考えてみた。
※バグはエラーとイコールではない。作者の意図しない動作はすべてバグである。

次のようなクラスモジュールを作ってみた。
コンストラクターでSheet1のA1セルにHelloを書き込み、デストラクターでGood Bye!を書き込む。

Private Sub Class_Initialize()
    Sheet1.Range("A1").Value = "Hello"
End Sub

Sub hoge()
    Sheet1.Range("A1").Value = "hoge"
End Sub

Private Sub Class_Terminate()
    Sheet1.Range("A1").Value = "Good Bye!"
End Sub

そして標準モジュール。
まずは宣言とNewを分けた場合。

Sub 宣言とNewを分ける()
    Sheet1.Range("A1").Value = "Start"
    Dim c As Class1
    Set c = New Class1
    Debug.Print Sheet1.Range("A1").Value
    c.hoge
    Debug.Print Sheet1.Range("A1").Value
    Set c = Nothing
    Debug.Print Sheet1.Range("A1").Value
End Sub

結果はこうなった。

Hello
hoge
Good Bye!

最初にA1セルにStartを入れているが、cにNew Class1を代入した時点でコンストラクターによりA1にはHelloが入るため、Debug.Printで最初の出力はHelloとなっている。

次に宣言時にNewした場合。

Sub 宣言時にNewする()
    Sheet1.Range("A1").Value = "Start"
    Dim c As New Class1
    Debug.Print Sheet1.Range("A1").Value
    c.hoge
    Debug.Print Sheet1.Range("A1").Value
    Set c = Nothing
    Debug.Print Sheet1.Range("A1").Value
End Sub

結果はこうなった。

Start
hoge
Good Bye!

変数宣言時にNewしているためここではまだオブジェクトは生成されず、A1の値はStartとでる。
次にhogeが実行される瞬間、コンストラクターによりA1の値がHelloに書き換えられるが、直後にhogeが実行されてA1の値はhogeになってしまう。

折角コンストラクターを作ったのに無意味な動作になってしまったため、これはバグだと言える。

あるいは別のシチュエーションとして、すでにNothingを代入して破棄したオブジェクトを間違って参照してしまったとき、そのコードが動いてしまうことだ。
さらにまずいことに、内部ではオブジェクトが再作成されるため、再度コンストラクターが実行されることだ。
まあこれはプログラマーのミスなのであるが、変数宣言とNewを分けておけば、破棄したはずのオブジェクト変数に再アクセスしてしまった際にちゃんとエラーで知らせてくれる。

まとめ

現実にはコンストラクターでRangeを書き換えるなんて特殊なことはやらないと思うので個人的には変数宣言時にNewを使って問題が発生するようなシチュエーションはめったにない。
ただし、今後も問題が発生するようなコードを書かないとは言い切れないし、Microsoftが推奨していない以上は変数宣言時のNewはやめたほうが良いだろうなと思う。
ということで、今後は変数宣言時のNewは封印しようと思う。

VBA 脱初心者を目指す ～ Functionを使いこなすにはHowではなく、Whatに注目する

VBA

VBAではFunctionプロシージャを使いこなせるようになったら、中級の域に達したと言っていいと思う。あくまで個人的な意見であるが。

さて、Functionプロシージャの仕組み自体は、それほど難しいものではない。ただ初心者の方と話をしていると、Functionを使うと「あっちいったりこっちいったり」するので難しいとのこと。

ひょっとするとコードを読み込んでいくなかで、Functionの中身まで読んでしまうことが難しいと感じる原因かもしれない。

こういうコードの読み方をしていないだろうか。
f:id:t-hom:20160925031617p:plain

Functionはプロシージャのコードが見えてしまっているがために、中身を理解しようとして、本筋に戻った時に「あれ？なんだっけ」となりやすい。

Functionプロシージャはそういう読み方をするものではない。
むしろ、コードを隅々まで読みたくないがために、Functionプロシージャを作るのだと考えることもできる。
※それがFunctionの主目的ではないが、副次的なメリットである。

Functionを使いこなすにはHowではなく、Whatに注目する

VBAの組み込み関数を使用するケースをイメージしてほしい。
たとえば文字列を左から任意個切り取る、Left関数など。
使うときにいちいち仕組みがどうなっているか気にするだろうか。
まあ一度くらい気にしたことはあるかもしれないが、大抵の場合意識するのは「What(何がなされるか)」であって、「How(どのようになされるか)」ではない。

先ほどのLeft関数でたとえば、以下のプログラムを作るとする。

Sub Left関数サンプル
    MsgBox Left("Hello, VBA", 5)
End Sub

この場合、「"Hello, VBA"に対して左から5文字切り取られる」ということは意識しても、内部でどのように文字列を加工しているかは意識しないだろう。

自分でFunctionプロシージャを作るときも、基本的な考え方は同じである。
Functionを作るときはもちろんHowを意識する必要があるが、いちど作ってしまえばWhatを覚えておくだけで良い。

他人の書いたFunctionを読む

他人の書いたプログラムを読むとき、Functionが多用されているケースはどう読むのか。
メインコードから順にトレースしていきFunction呼び出しが出てきたときにその中身を確認する方法もあるが、この読み方だと「あっちいったりこっちいったり」になってしまう。

この読み方が難しいのは、メインコードのロジックを一旦脇においてFunctionの中身を確認する際、Functionのロジックに集中すると、脇においていたメインコードのロジックを忘れてしまう点にある。
あるいはメインロジックとFunctionのロジックがごっちゃになってこんがらがる。

個人的におススメする読み方は、まず最初にFunctionを読んでWhatを把握してしまうことである。
覚えておくのが難しければ、最初に理解したタイミングでコメントを書いてしまえばよい。

中にはFunctionの中でさらに別のFunctionを読んでいるケースもある。
難しいと感じる場合は一度呼び出し関係を図にしてしまうといい。

【参考】
thom.hateblo.jp

自分でFunctionを作るときに気を付けたいこと

まず一番大事なのは、Function名である。
そのFunctionが何をするものなのか、つまりWhatを適切に表現した名前を付けることで、中身を読む前にその関数の働きを想像することができる。
また、一度読んだ後に名前と結び付けて記憶に残りやすい。

myFunc1といった適当な名前を付けてしまうと、結局内部動作とmyFunc1という関数名の結び付けを頭の中で無理に覚えておかなければならない。
名前から自然にその働きが想起できることが重要である。ひねったりせず、安直で一目瞭然な名前を付けること。

また、自分だけでなく他人が読んだときにも分かりやすい名前にしておくことが重要だ。
ためしにFunction名だけ同僚に見せて、何をする関数なのか当ててもらうと良い。
的中または惜しい答えが返ってきたら、それは理想的な名前に近いと思われる。
「いや、そのまんまやんけお前！」とツッコミをいただいたら100点だ。

GetApplicationConfigurationStringやSaveAllChangeSetToDatabaseなんていう長い関数名の事例もある。
以下のページ、トピ主は長すぎる関数名に違和感を感じているようだが、対するコメントはおおむね「省略すべきではない」との見方が多い。

【参考】長い関数名、変数名、どこまで許せる？ | スラド

VBAなら日本語でFunction名を付けることもできる。
例) GetApplicationConfigurationStringの代わりに「アプリ設定の文字列を取得」という関数名
個人や内輪で使うツールなら日本語を使っても問題ない。

次に大事なのは、参照透過性(さんしょうとうかせい)である。
これについては過去に書いた以下の記事を参照してほしい。
thom.hateblo.jp

まとめ

  • Functionは、Whatを把握するために読む。WhatがわかればHowは忘れて良い。
  • 呼び出し関係が分かりにくいときは図にまとめよう。
  • 自分でFunctionを作るときは、その働きを想起させる適切な名前を付ける。
  • Functionはなるべく参照透過に設計する。

Excel TRIM関数で消えない謎の半角スペースをVBAでなんとかする

VBA

先日、仕事で受け取ったExcelデータにTRIM関数で除去できない謎の半角スペースが混じっていた。

その現象を再現したのがこちら。
f:id:t-hom:20160920135926p:plain

A1セルとA2セルは全く同じに見えるが、A1セルの1文字目はトリムできない謎のスペース。A2セルの方は通常のスペースである。

このようにTRIM関数を使っても、スペースが消えてくれない。
f:id:t-hom:20160920140154p:plain

VBAで謎のスペースを調査

いったいこのスペースは何なのか。VBAで調べてみた。
まずはふつうにイミディエイトウインドウに出力してみる。

Sub とりあえず出力()
    Debug.Print Range("A1").Value
    Debug.Print Range("A2").Value
End Sub

すると結果は、、んん？
f:id:t-hom:20160920140434p:plain

なぜかA1セルのスペースはクエッションマークとして表示されるようだ。

ひと文字だけで試してみる。

Sub 謎のスペースだけ出力()
    謎のスペース = Left(Range("A1").Value, 1)
    Debug.Print 謎のスペース
End Sub

結果は「?」がひと文字表示された。
これってただのハテナなのか？

比較してみる。

Sub 謎のスペースはハテナなのか()
    謎のスペース = Left(Range("A1").Value, 1)
    Debug.Print 謎のスペース = "?"
End Sub

結果はFalse。
ただのハテナではないようだ。
では文字コードを見てみよう。

Sub 謎のスペースの文字コードは()
    謎のスペース = Left(Range("A1").Value, 1)
    Debug.Print Asc(謎のスペース)
End Sub

「63」とのこと。
ASCIIコード表で調べてみると、、
ASCII文字コード - IT用語辞典

やっぱりハテナ。。
ちなみに文字コード同士の比較だと一致する。

Sub 文字コード同士を比較()
    謎のスペース = Left(Range("A1").Value, 1)
    Debug.Print Asc(謎のスペース) = Asc("?")
End Sub

これはお手上げかーと思ったそのとき、最後の一手がひらめいた。
そうだ、文字列とByte型配列は相互置換できるんだった。

Byte型配列を使って謎のスペースの正体にせまる。

ということで、謎のスペースをByte型配列に代入し、その数値を見てみることにした。

Sub バイト型配列を使って正体を暴く()
    Dim 謎のスペース() As Byte
    謎のスペース = Left(Range("A1").Value, 1)
    
    Debug.Print "---謎のスペースのコード---"
    Debug.Print 謎のスペース(0)
    Debug.Print 謎のスペース(1)
    
    Dim ハテナ() As Byte
    ハテナ = "?"
    
    Debug.Print "---ハテナのコード---"
    Debug.Print ハテナ(0)
    Debug.Print ハテナ(1)
End Sub

すると！
f:id:t-hom:20160920142410p:plain

でたっ！やっぱByteデータは嘘つかない。

「文字コード 160」でGoogle検索してみたところ、謎のスペースの正体は、HTMLでよく利用される、NBSP(ノーブレークスペース)だった。

ノーブレークスペース - Wikipedia

NBSPを除去する関数を作成

さて、謎のスペースの正体が分かったところで、今度はそれを除去する関数がほしい。
Chr(160)で簡単にできるかなと思っていたけれど、失敗。
ここでもByte配列を使用することにした。
できたのがこちら。

Function NBSP2SP(str As String) As String
    Dim nbsp(0 To 1) As Byte
    nbsp(0) = 160
    nbsp(1) = 0
    NBSP2SP = Replace(str, nbsp, " ")
End Function

実際に使ってみた。

Sub サンプル()
    Debug.Print "--普通にTrim出力--"
    Debug.Print Trim(Range("A1").Value)
    
    Debug.Print "--NBSPを除去してTrim出力--"
    Debug.Print Trim(NBSP2SP(Range("A1").Value))
End Sub

結果はこのとおり。
f:id:t-hom:20160920144107p:plain
きれいにTrimされている。

今回のようなケースは、ブラウザからExcelに文字列を張り付けた際に発生する場合がある。
特に、表のマージンをCSSではなくnbspで調整しているケースで、表をそのまま文字選択してExcelに張り付けるような操作をすると発生する。
受け取ったExcelデータにTrimできない余分なスペースがあったら、VBAで除去しよう。

2018/07/18 追記

teratailで以下質問に答えたところhatena19さんから補足をいただいたので紹介。
teratail.com

Unicode文字ならわざわざバイト調べなくても標準のAscW、ChrW関数が使えるとのこと。

Function NBSP2SP(str As String) As String
    NBSP2SP = Replace(str, ChrW(160), " ")
End Function

amazonアソシエイトのウィジェットがChromeで自動再生されなくなったのでランダムに商品を並べる機能をJavaScriptで自作する。

プログラミング

このブログはamazonアソシエイトに参加しており、その広告収益を運営費に充てている。
先日までこのブログのサイドバーにはA8.netの固定バナーを表示していたが、まったく収益になってなかったので、そちらを削除して空いたスペースにおススメの小説を掲載することにした。

当初はamazonのスライドショーウィジェットが良さげだったのでそれを使う予定だったのだが、配置してみたところ自動再生されない。
調べたところ、去年の9月のアップデートで、Google Chromeでは重要でないFlash(つまり広告)は自動再生されない仕様になったとのこと。
www.itmedia.co.jp

広告というのは勝手に目に飛び込んでくるから興味を引くのであって、わざわざクリックして再生してくれるユーザーはほとんど居ない。
それでスライドショーウィジェットを使う案はボツ。

Flashを使わないお気に入りウィジェットというのも試してみたけれど、どうも商品画像が小さすぎて興味をそそられない。
「これ欲しい」とか、「これ面白そう」というのは直感的なもので、小っちゃい文字と小っちゃい画像ではインパクトに欠ける。
やはりバーンと画像で魅せないと。

やりたいことは、自分のおススメの小説をランダムに3つくらい、大きめの画像で表示させること。
ということで、JavaScriptで自作することにした。

まず、amazonアソシエイトの商品リンクで画像のみのサイズ中を選択し、URLを取得する。
すると、以下のようなURLが取得できる。

<a  href="https://www.amazon.co.jp/gp/product/B0093GE1UM/ref=as_li_tf_il?ie=UTF8&camp=247&creative=1211&creativeASIN=B0093GE1UM&linkCode=as2&tag=hogehoge"><img border="0" src="http://ws-fe.amazon-adsystem.com/widgets/q?_encoding=UTF8&ASIN=B0093GE1UM&Format=_SL160_&ID=AsinImage&MarketPlace=JP&ServiceVersion=20070822&WS=1&tag=hogehoge" ></a><img src="http://ir-jp.amazon-adsystem.com/e/ir?t=hogehoge&l=as2&o=9&a=B0093GE1UM" width="1" height="1" border="0" alt="" style="border:none !important; margin:0px !important;" />

このうち、可変項目は、商品コード「B0093GE1UM」と自分のID「hogehoge」なので、そこだけ変数にしてループで回せば別の商品を次々に表示できる。
また、おススメ商品群から3つピックアップしたかったので、配列からランダムでピックアップする処理にした。

サイドバーのモジュールに埋め込んだコードは以下のとおり。

<p>オススメ！松岡 圭祐 Kindle本</p>
<div id="amazon_km_kindle" style="margin-left:20px;">
</div>
<script type="text/javascript"><!--
window.onload = function(){
	var asins = [ "B009GPMSN2", "B0093GE1UM", "B009VZ8L5G", "B00QJDTG2K", "B016KDOC36" ] ;
	var associate_id = "hogehoge";
	var display_number = 3;
	for(var i = 0; i < display_number; i++) {
	    var a = Math.floor( Math.random() * asins.length )
	    var asin = asins.splice(a,1);

	    var anchor = document.createElement("a");
	    anchor.href = "https://www.amazon.co.jp/gp/product/" + asin
	    	+ "/ref=as_li_tf_il?ie=UTF8&camp=247&creative=1211&creativeASIN=" + asin
	    	+ "&linkCode=as2&tag=" + associate_id;
	    
		var img1 = document.createElement("img");
		img1.src = "http://ws-fe.amazon-adsystem.com/widgets/q?_encoding=UTF8&ASIN=" + asin
			+ "&Format=_SL160_&ID=AsinImage&MarketPlace=JP"
			+ "&ServiceVersion=20070822&WS=1&tag=" + associate_id;
		img1.border = "0";
		
		anchor.appendChild(img1)
		
		var img2 = document.createElement("img");
		img2.src = "http://ir-jp.amazon-adsystem.com/e/ir?t=" + associate_id + "&l=as2&o=9&a=" + asin;
		img2.width = "1";
		img2.height = "1";
		img2.border = "0";
		img2.alt = "";
		img2.style = "border:none !important; margin:0px !important;";

	    var div = document.getElementById("amazon_km_kindle");
	    div.appendChild(anchor);
	    div.appendChild(img2);
	}
}
// --></script>

JavaScriptで配列と呼ばれるものは、実はリスト構造になっているようで、データの切り出しや挿入用の命令が用意されている。
VBAやCを経験した人からするとリスト構造を配列と呼ぶのは違和感があるかもしれない。

【参考：VBAの場合、配列はそのまま配列構造】
thom.hateblo.jp

JavaScriptの配列は非常に多機能で使い勝手がよく、pushやpopでスタックのような操作ができたり、spliceでデータの一部を切り出したり、joinで文字列結合させたりできる。

さて、このブログの読者はVBA使いがメインだと思うので、前述のJavaScriptのうち、商品群からランダムに3つピックアップする処理について、VBAでもやってみようと思う。
VBAで書くと、こうなる。

Sub 束からランダムに3つピックアップ()
    '配列を準備
    Dim asinArray()
    asinArray = Array("B009GPMSN2", "B0093GE1UM", "B009VZ8L5G", "B00QJDTG2K", "B016KDOC36")
    
    'コレクションに格納
    Dim asinCollection As New Collection
    Dim asinCode
    For Each asinCode In asinArray
        asinCollection.Add asinCode
    Next
    
    'ランダムにピックアップ
    Dim i, n
    For i = 1 To 3
        n = Int((asinCollection.Count) * Rnd + 1)
        Debug.Print asinCollection(n)
        asinCollection.Remove n     '同じコードを取らないように取り除く
    Next
End Sub

JavaScriptの場合は配列がリスト構造なので扱いやすいが、VBAの場合は一旦操作しやすいCollectionに格納する。
JavaScriptの配列はspliceメソッドで値を取出しつつ、配列から取り除くことができるが、VBAのCollectionの場合は別途Removeが必要となる。

束から重複なくランダムにピックアップする処理はいろいろと応用が利く。
たとえば、全て取り出して別のコレクションにAddすればコレクションのシャッフルができる。
あるいは問題集からランダムな30問を表示させることもできる。

言語が変わってもこうしたアルゴリズムは潰しが利くので覚えておくとよいと思う。

VBA 配列とコレクションの違いをメモリ上のデータ構造から理解する

VBA VBAの研究・考察

VBAでは複数データを格納できるデータ型として、配列とコレクションがある。
それぞれ一長一短あり、どちらが優れているというものではないのだが、どちらかといえばデータの追加・削除が簡単に行えるコレクションのほうが使い勝手は良いかもしれない。

さて、今回は配列とコレクションのデータ構造に焦点を当ててそれぞれの違いを説明する。

配列のデータ構造

例えばInteger型の配列を次のように作成する。

Dim Arr(3) As Integer
Arr(0) = 10
Arr(1) = 20
Arr(2) = 30
Arr(3) = 40

すると、メモリ上には単に直列にデータが並ぶ。VBAのIntegerは2バイトなので、ちょうど2バイトずつ隙間なく配置される。
f:id:t-hom:20160831000135p:plain

もし次のようにLong型で宣言したら、

Dim Arr(3) As Long
Arr(0) = 100
Arr(1) = 200
Arr(2) = 300
Arr(3) = 400

Long型は4バイトなので、やはり4バイトずつ隙間なくメモリに配置される。
f:id:t-hom:20160831000436p:plain

このように隙間なく並べることで、添え字(インデックス)が大きくなっても、データの格納位置を瞬時に割り出すことができる。
どういうことか、先ほどのLong型配列の例で説明する。

例えば次のようにArr(3)の値を表示する命令が実行されたとする。

MsgBox Arr(3)

VBAはまず、Arr(3)がメモリ上のどの場所に格納されているかを探しだす。

配列Arrの先頭アドレスは10000000なので、これに(添え字×型のデータサイズ)を加えてやれば、アドレスが求まる。
添え字は3で、Long型のサイズは4なので、3 × 4 = 12。
先頭アドレスの10000000に12を加えた10000012が目的のデータのアドレスであるとわかる。

そして、アドレスの10000012番地にある値「400」をメッセージボックスで表示する。
以上が配列の参照時の動作である。

配列の添え字(インデックス)を先頭アドレスからのオフセットとして利用するためには、隙間なくデータが並んでいなければならない。

以下のように、別のデータがメモリに入っていたら、もうそれ以上はデータを増やせない。
f:id:t-hom:20160831001754p:plain

なぜなら、仮に次の空き番地にデータを入れたとしても、添え字からデータ位置を割り出すことができなくなるので、データを取り出せなくなってしまうからだ。

配列は宣言時にサイズを決め、そのあと原則サイズ変更ができないが、これはつまり、最初にメモリの連続した領域を確保してしまう必要がある為だ。

ちなみに動的配列はReDimでサイズ変更ができるが、あれも厳密にいえば別の領域に新たな連続したメモリ領域を確保して配列を再作成している。
だから命令の名前もExpand(拡張)じゃなくて、Re(再)Dimとなっている。Preserveを付けないと中身が消えてしまうという説明がなされるが、正確に言えばPreserveを付けると旧メモリ領域からデータをコピーしてくれるということである。

自分で確かめたい場合は以下を試してみると良い。

Sub ReDimでアドレスが変わるサンプル()
    Dim Arr() As Integer
    ReDim Arr(2)
    Arr(0) = 10
    Arr(1) = 20
    Arr(2) = 30
    
    Debug.Print "配列のアドレス"
    For i = 0 To 2
        Debug.Print "Arr(" & i & ") : "; VarPtr(Arr(i))
    Next
    
    ReDim Preserve Arr(3)
    Arr(3) = 40
    
    Debug.Print
    Debug.Print "ReDim後のアドレス"
    For i = 0 To 3
        Debug.Print "Arr(" & i & ") : "; VarPtr(Arr(i))
    Next
End Sub

コレクションのデータ構造

Collectionという名称はMicrosoftが付けたものであるが、データ構造の一般名称としては「連結リスト」または単に「リスト」と呼ばれている。

リスト構造では、以下のようにデータと次のデータ位置を示すアドレスがセットで格納されている。
f:id:t-hom:20160831004315p:plain

(注)メモリ図はあくまでイメージです。紙面の都合でアドレス欄(水色)を1バイトとしましたが、アドレス番号を格納するには少なくとも4バイト必要です。

リストの場合、配列と違って隙間なくデータを並べておく必要がなく、空いているアドレスにデータを追加することができる。

情報処理試験などでは、次のような図で表されることも多い。
f:id:t-hom:20160831004105p:plain

新たにデータを追加したい場合は任意の場所にデータを追加し、前の要素のアドレス欄を書き換えれば良い。
f:id:t-hom:20160831004831p:plain

データの挿入も、前の要素のアドレス欄を書き換えてから、挿入する要素のアドレス欄に次の要素のアドレスを格納すれば良い。
f:id:t-hom:20160831005117p:plain

削除もアドレス欄の書き換えだけで済む。
f:id:t-hom:20160831005556p:plain

VBAのCollection型はリスト構造なので、データの追加や削除が簡単に行うことができる。
データを参照するにはリストの開始位置から順にリストを辿っていけば良い。

例えば次のプログラムは、3番目にAddされた「30」を表示する。

Sub fuga()
    Dim C As New Collection
    C.Add 10
    C.Add 20
    C.Add 30
    
    MsgBox C(3)
End Sub

この時、内部では次のようにリストを先頭から順に辿る処理がなされている。

1番目のアドレス欄を参照し、2番目のデータ位置を確認する。
2番目のアドレス欄を参照し、3番目のデータ位置を確認する。
3番目のデータにたどり着いたので、それを表示する。

配列のように添え字からの計算で格納位置を求めることができないため、愚直にリストを辿るしかないのである。
だから理屈上は、後ろのほうに追加されたデータのほうが参照するのに時間がかかることになる。

これを実証するには、次のマクロを利用すると良い。

Sub コレクションの速度計測()
    Dim C As New Collection
    Debug.Print "準備しています。お待ちください。"
    For i = 1 To 10 ^ 7
        C.Add i
    Next
    Debug.Print "計測を開始します。"
    
    n = 100
    For i = 1 To 7
        T = Timer
        For j = 1 To n
            Void = C(10 ^ i)
        Next
        Debug.Print 10 ^ i; "番目のデータを"; n; "回参照するのに"; Round(Timer - T, 5); "秒かかりました。"
    Next
    Debug.Print "計測を終了しました。"
End Sub

私のPC環境だと、次のような結果になった。
f:id:t-hom:20160831012802p:plain

確かに、後ろのほうに追加されたデータのほうが参照するのに時間がかかっている。

次に配列でやってみよう。

Sub 配列の速度計測()
    Dim Arr(10 ^ 7)
    Debug.Print "準備しています。お待ちください。"
    For i = 0 To 10 ^ 7
        Arr(i) = i
    Next
    Debug.Print "計測を開始します。"
    n = 10000
    For i = 1 To 7
        T = Timer
        For j = 1 To n
            Void = Arr(10 ^ i)
        Next
        Debug.Print 10 ^ i; "番目のデータを"; n; "回参照するのに"; Round(Timer - T, 5); "秒かかりました。"
    Next
    Debug.Print "計測を終了しました。"
End Sub

参照回数が100回ずつだとすべて0秒で終わってしまったので、nの値は10000とした。
これだけ見ても配列がいかに高速かがわかる。

そして、私のPC環境での実行結果は、次のようになった。
f:id:t-hom:20160831013124p:plain

すでに説明したとおり、添え字から計算でデータの格納アドレスを求めているため、参照位置が変わっても速度に差は出ない。
コレクションで後方のデータほど時間がかかるのとは対照的である。

まとめ

今回は普段使っている配列やコレクションのデータ構造について解説した。
サンプルでは検証のためにわざと有意差が出るようにループ回数やサイズを調整したが、これはあくまでデータ構造の説明に説得力を持たせるためのサンプルであって、配列のほうが高速だから優れていると言いたいわけではない。
実際に配列のメリットとして高速であるという説明がなされることがあるが、実務で扱う数万件程度のデータなら大差ないので速度はそれほどアピールポイントにはならない。

配列のメリットとしては、ArrayやSplitなどで動的に生成できることや、Join関数で結合できること、2次元配列のセルとの相互転記ができること、宣言時に型をカチっと決められるためオブジェクト型の配列にしたときにドットでプロパティとメソッドの入力候補が表示されること等が挙げられる。

コレクションのメリットは、データの追加・削除・挿入が容易であることと、キー文字列を設定でき、インデックスの変わりにキーを使ってデータ参照できる点が挙げられる。

それぞれ一長一短あるので、配列派、コレクション派ということではなく、どちらも自在に使いこなせるようになりたい。

VBA 新しい色の指定方法 ～XlRgbColor定数

VBA

VBAで使える色定数は以下の8種類がある。

  • vbBlack
  • vbBlue
  • vbCyan
  • vbGreen
  • vbMagenta
  • vbRed
  • vbWhite
  • vbYellow

私も今までこれ以外使ったことが無かったが、先日オブジェクトブラウザを探索していたらXlRgbColor列挙型なるものを発見した。rgbAliceBlueとか、rgbAntiqueWhiteといった色名が登録されており、定数として利用できる。

わざわざ色名なんて調べなくてもRGB関数で好きな色を作れるのだが、あえて色名で指定するのも情緒があって良い。

しかし実際にどんな色なのかは、いちいち指定してみないとわからないので面倒くさい。

ということで、一覧を作ることにした。

まずMSDNに色名の表があったので、そちらを選択してExcelに張り付ける。
https://msdn.microsoft.com/ja-jp/library/office/ff197459.aspx

f:id:t-hom:20160822215419p:plain

そして値を全選択し、
f:id:t-hom:20160822215510p:plain

以下のマクロを実行すれば完成

Sub 色付け()
    Dim R As Range
    For Each R In Selection
        R.Interior.Color = R.Value
    Next
End Sub

f:id:t-hom:20160822215624p:plain

気に入った色があれば、次のように指定できる。

Range("A1").Interior.Color = rgbLavender

また、色名の一覧から選択したい場合は列挙型名の「XlRgbColor」を入力し、ドット入力すると候補一覧が表示される。
f:id:t-hom:20160822221639p:plain

選択すると以下のようになるが、XlRgbColorは有っても無くても動作に変わりはない。
(同名の自作変数や関数が存在する場合を除く)

Range("A1").Interior.Color = XlRgbColor.rgbLavender

さて、MSDNのアドレスが変わってしまったりするとアレなので、一応単体で色一覧を出力するマクロも作ってみた。
(ちょっと長いけれど、これを実行するとアクティブシートに色一覧が作成される。)

Sub 色一覧作成()
    Dim R As Range: Set R = Range("A1")
    R.Interior.Color = rgbAliceBlue: R.Offset(0, 1).Value = "rgbAliceBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbAntiqueWhite: R.Offset(0, 1).Value = "rgbAntiqueWhite": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbAqua: R.Offset(0, 1).Value = "rgbAqua": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbAquamarine: R.Offset(0, 1).Value = "rgbAquamarine": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbAzure: R.Offset(0, 1).Value = "rgbAzure": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBeige: R.Offset(0, 1).Value = "rgbBeige": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBisque: R.Offset(0, 1).Value = "rgbBisque": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBlack: R.Offset(0, 1).Value = "rgbBlack": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBlanchedAlmond: R.Offset(0, 1).Value = "rgbBlanchedAlmond": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBlue: R.Offset(0, 1).Value = "rgbBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBlueViolet: R.Offset(0, 1).Value = "rgbBlueViolet": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBrown: R.Offset(0, 1).Value = "rgbBrown": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbBurlyWood: R.Offset(0, 1).Value = "rgbBurlyWood": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbCadetBlue: R.Offset(0, 1).Value = "rgbCadetBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbChartreuse: R.Offset(0, 1).Value = "rgbChartreuse": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbCoral: R.Offset(0, 1).Value = "rgbCoral": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbCornflowerBlue: R.Offset(0, 1).Value = "rgbCornflowerBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbCornsilk: R.Offset(0, 1).Value = "rgbCornsilk": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbCrimson: R.Offset(0, 1).Value = "rgbCrimson": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkBlue: R.Offset(0, 1).Value = "rgbDarkBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkCyan: R.Offset(0, 1).Value = "rgbDarkCyan": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkGoldenrod: R.Offset(0, 1).Value = "rgbDarkGoldenrod": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkGray: R.Offset(0, 1).Value = "rgbDarkGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkGreen: R.Offset(0, 1).Value = "rgbDarkGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkGrey: R.Offset(0, 1).Value = "rgbDarkGrey": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkKhaki: R.Offset(0, 1).Value = "rgbDarkKhaki": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkMagenta: R.Offset(0, 1).Value = "rgbDarkMagenta": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkOliveGreen: R.Offset(0, 1).Value = "rgbDarkOliveGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkOrange: R.Offset(0, 1).Value = "rgbDarkOrange": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkOrchid: R.Offset(0, 1).Value = "rgbDarkOrchid": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkRed: R.Offset(0, 1).Value = "rgbDarkRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkSalmon: R.Offset(0, 1).Value = "rgbDarkSalmon": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkSeaGreen: R.Offset(0, 1).Value = "rgbDarkSeaGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkSlateBlue: R.Offset(0, 1).Value = "rgbDarkSlateBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkSlateGray: R.Offset(0, 1).Value = "rgbDarkSlateGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkSlateGrey: R.Offset(0, 1).Value = "rgbDarkSlateGrey": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkTurquoise: R.Offset(0, 1).Value = "rgbDarkTurquoise": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDarkViolet: R.Offset(0, 1).Value = "rgbDarkViolet": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDeepPink: R.Offset(0, 1).Value = "rgbDeepPink": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDeepSkyBlue: R.Offset(0, 1).Value = "rgbDeepSkyBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDimGray: R.Offset(0, 1).Value = "rgbDimGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDimGrey: R.Offset(0, 1).Value = "rgbDimGrey": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbDodgerBlue: R.Offset(0, 1).Value = "rgbDodgerBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbFireBrick: R.Offset(0, 1).Value = "rgbFireBrick": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbFloralWhite: R.Offset(0, 1).Value = "rgbFloralWhite": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbForestGreen: R.Offset(0, 1).Value = "rgbForestGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbFuchsia: R.Offset(0, 1).Value = "rgbFuchsia": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGainsboro: R.Offset(0, 1).Value = "rgbGainsboro": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGhostWhite: R.Offset(0, 1).Value = "rgbGhostWhite": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGold: R.Offset(0, 1).Value = "rgbGold": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGoldenrod: R.Offset(0, 1).Value = "rgbGoldenrod": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGray: R.Offset(0, 1).Value = "rgbGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGreen: R.Offset(0, 1).Value = "rgbGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGreenYellow: R.Offset(0, 1).Value = "rgbGreenYellow": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbGrey: R.Offset(0, 1).Value = "rgbGrey": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbHoneydew: R.Offset(0, 1).Value = "rgbHoneydew": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbHotPink: R.Offset(0, 1).Value = "rgbHotPink": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbIndianRed: R.Offset(0, 1).Value = "rgbIndianRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbIndigo: R.Offset(0, 1).Value = "rgbIndigo": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbIvory: R.Offset(0, 1).Value = "rgbIvory": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbKhaki: R.Offset(0, 1).Value = "rgbKhaki": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLavender: R.Offset(0, 1).Value = "rgbLavender": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLavenderBlush: R.Offset(0, 1).Value = "rgbLavenderBlush": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLawnGreen: R.Offset(0, 1).Value = "rgbLawnGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLemonChiffon: R.Offset(0, 1).Value = "rgbLemonChiffon": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightBlue: R.Offset(0, 1).Value = "rgbLightBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightCoral: R.Offset(0, 1).Value = "rgbLightCoral": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightCyan: R.Offset(0, 1).Value = "rgbLightCyan": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightGoldenrodYellow: R.Offset(0, 1).Value = "rgbLightGoldenrodYellow": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightGray: R.Offset(0, 1).Value = "rgbLightGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightGreen: R.Offset(0, 1).Value = "rgbLightGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightGrey: R.Offset(0, 1).Value = "rgbLightGrey": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightPink: R.Offset(0, 1).Value = "rgbLightPink": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightSalmon: R.Offset(0, 1).Value = "rgbLightSalmon": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightSeaGreen: R.Offset(0, 1).Value = "rgbLightSeaGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightSkyBlue: R.Offset(0, 1).Value = "rgbLightSkyBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightSlateGray: R.Offset(0, 1).Value = "rgbLightSlateGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightSteelBlue: R.Offset(0, 1).Value = "rgbLightSteelBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLightYellow: R.Offset(0, 1).Value = "rgbLightYellow": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLime: R.Offset(0, 1).Value = "rgbLime": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLimeGreen: R.Offset(0, 1).Value = "rgbLimeGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbLinen: R.Offset(0, 1).Value = "rgbLinen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMaroon: R.Offset(0, 1).Value = "rgbMaroon": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumAquamarine: R.Offset(0, 1).Value = "rgbMediumAquamarine": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumBlue: R.Offset(0, 1).Value = "rgbMediumBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumOrchid: R.Offset(0, 1).Value = "rgbMediumOrchid": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumPurple: R.Offset(0, 1).Value = "rgbMediumPurple": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumSeaGreen: R.Offset(0, 1).Value = "rgbMediumSeaGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumSlateBlue: R.Offset(0, 1).Value = "rgbMediumSlateBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumSpringGreen: R.Offset(0, 1).Value = "rgbMediumSpringGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumTurquoise: R.Offset(0, 1).Value = "rgbMediumTurquoise": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMediumVioletRed: R.Offset(0, 1).Value = "rgbMediumVioletRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMidnightBlue: R.Offset(0, 1).Value = "rgbMidnightBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMintCream: R.Offset(0, 1).Value = "rgbMintCream": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMistyRose: R.Offset(0, 1).Value = "rgbMistyRose": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbMoccasin: R.Offset(0, 1).Value = "rgbMoccasin": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbNavajoWhite: R.Offset(0, 1).Value = "rgbNavajoWhite": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbNavy: R.Offset(0, 1).Value = "rgbNavy": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbNavyBlue: R.Offset(0, 1).Value = "rgbNavyBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOldLace: R.Offset(0, 1).Value = "rgbOldLace": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOlive: R.Offset(0, 1).Value = "rgbOlive": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOliveDrab: R.Offset(0, 1).Value = "rgbOliveDrab": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOrange: R.Offset(0, 1).Value = "rgbOrange": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOrangeRed: R.Offset(0, 1).Value = "rgbOrangeRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbOrchid: R.Offset(0, 1).Value = "rgbOrchid": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPaleGoldenrod: R.Offset(0, 1).Value = "rgbPaleGoldenrod": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPaleGreen: R.Offset(0, 1).Value = "rgbPaleGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPaleTurquoise: R.Offset(0, 1).Value = "rgbPaleTurquoise": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPaleVioletRed: R.Offset(0, 1).Value = "rgbPaleVioletRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPapayaWhip: R.Offset(0, 1).Value = "rgbPapayaWhip": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPeachPuff: R.Offset(0, 1).Value = "rgbPeachPuff": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPeru: R.Offset(0, 1).Value = "rgbPeru": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPink: R.Offset(0, 1).Value = "rgbPink": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPlum: R.Offset(0, 1).Value = "rgbPlum": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPowderBlue: R.Offset(0, 1).Value = "rgbPowderBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbPurple: R.Offset(0, 1).Value = "rgbPurple": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbRed: R.Offset(0, 1).Value = "rgbRed": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbRosyBrown: R.Offset(0, 1).Value = "rgbRosyBrown": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbRoyalBlue: R.Offset(0, 1).Value = "rgbRoyalBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSalmon: R.Offset(0, 1).Value = "rgbSalmon": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSandyBrown: R.Offset(0, 1).Value = "rgbSandyBrown": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSeaGreen: R.Offset(0, 1).Value = "rgbSeaGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSeashell: R.Offset(0, 1).Value = "rgbSeashell": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSienna: R.Offset(0, 1).Value = "rgbSienna": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSilver: R.Offset(0, 1).Value = "rgbSilver": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSkyBlue: R.Offset(0, 1).Value = "rgbSkyBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSlateBlue: R.Offset(0, 1).Value = "rgbSlateBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSlateGray: R.Offset(0, 1).Value = "rgbSlateGray": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSnow: R.Offset(0, 1).Value = "rgbSnow": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSpringGreen: R.Offset(0, 1).Value = "rgbSpringGreen": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbSteelBlue: R.Offset(0, 1).Value = "rgbSteelBlue": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbTan: R.Offset(0, 1).Value = "rgbTan": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbTeal: R.Offset(0, 1).Value = "rgbTeal": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbThistle: R.Offset(0, 1).Value = "rgbThistle": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbTomato: R.Offset(0, 1).Value = "rgbTomato": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbTurquoise: R.Offset(0, 1).Value = "rgbTurquoise": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbViolet: R.Offset(0, 1).Value = "rgbViolet": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbWheat: R.Offset(0, 1).Value = "rgbWheat": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbWhite: R.Offset(0, 1).Value = "rgbWhite": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbWhiteSmoke: R.Offset(0, 1).Value = "rgbWhiteSmoke": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbYellow: R.Offset(0, 1).Value = "rgbYellow": Set R = R.Offset(1, 0)
    R.Interior.Color = rgbYellowGreen: R.Offset(0, 1).Value = "rgbYellowGreen": Set R = R.Offset(1, 0)
End Sub

実行結果はこんな感じ。
f:id:t-hom:20160822220353p:plain

上記の長ったらしいマクロは、マクロを使って書いた。

MSDNからコピーした表の色名を全選択し、
f:id:t-hom:20160822220618p:plain

以下のようなマクロを作って実行すると、

Sub 色一覧作成マクロ生成()
    Debug.Print "Sub 色一覧作成()"
    Debug.Print "    Dim R As Range: Set R = Range(""A1"")"
    For Each x In Selection
        Debug.Print _
            "    R.Interior.Color = " & x.Value & _
            ": R.Offset(0,1).Value = """ & x.Value & """" & _
            ": Set R = R.Offset(1,0)"
    Next
    Debug.Print "End Sub"
End Sub

イミディエイトウインドウに色一覧作成マクロが生成される。
f:id:t-hom:20160822220807p:plain

あとはコピペするだけ。

プログラムにプログラムを書かせるテクニックは過去にも紹介しているので興味があればどうぞ。
thom.hateblo.jp
thom.hateblo.jp

VBA 初学者こそ、なんでもVBAでやるべし

VBA VBAについての考え・意見

Excelには高度な機能が備わっており、VBAを使わなくても例えば関数やピボットテーブルなどの機能で問題が解決してしまうことも多い。
その意味で、VBAでなんでもやろうとするのは効率が悪い。
でも、ことVBAの学習においては、それらExcelの機能を知っていることがむしろ弊害になってしまうこともあるように思う。

だって、すでに機能としてあるんだったら、作る必要がなくなってしまう。
だったら別のものを作ればいいじゃないかと言われても、そういつも思いつくものではない。

わざわざVBAでやらなくたって、○○で簡単にできる。
確かにそうかもしれないが、それってVBAの適用範囲を狭めてしまう。
結果的にVBAに触れる機会が少なくなってしまい、上達の機会も減る。

別に機能を知っていても「あえて学習のためにVBAで作る」ことはできる。
でも車輪の再発明と知っていながら学習のためと割り切って作るのと「これを完成させれば自分の仕事が楽になる」と思って作るのでは全く楽しさが違う。

特に初学のうちはまだ大きなマクロを作るのは難しい。だから、完成したら仕事が楽になり、なんとか自分で作れそうだという、動機・レベルがマッチした題材はなかなか見つからない。
もし「こういうことをしたい。VBAで実現できそうだ。」と思ったら、それは絶好の学習チャンスだ。そのチャンスを逃してはいけない。

「うーん。でもVBA使わなくてもできるんじゃないか。」とか、「他の人が何か良いマクロ作ってるんじゃないか。」とか、「手でやったほうが早いんじゃないか」とか考えてしまうと、せっかくのチャンスを自ら潰してしまうことになる。

Excelの機能を調べるなという話ではないが、はじめにVBAという選択肢が思い浮かんだなら、まずは試しに作ってみると良い。

VBA 初学者こそ、なんでもVBAでやるべし。
(逆にVBA上級者は、VBA以外の可能性も探ってみると良いと思う)

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。