準備

まずはソートの対象を用意しないといけないので、配列を作ることにした。

Sub MStart()'配列Arrの準備Dim Arr()AsLongConstMin=1,Max=10ReDim Arr(MinToMax)EndSub

後から配列の数を変更できるように動的配列として、ReDimにMinとMaxの定数を与える方式とした。

次に、配列にランダムな数を格納していく。
このとき、同時にイミディエイトウィンドウに出力するようにした。

Sub MStart()'配列Arrの準備Dim Arr()AsLongConstMin=1,Max=10ReDim Arr(MinToMax)'配列Arrにランダム数を格納しながら出力For i =LBound(Arr)ToUBound(Arr)Const LowerBound =1, UpperBound =100
        Arr(i)=Int((UpperBound - LowerBound +1)*Rnd+ LowerBound)
        Debug.Print i; ":"; Arr(i)NextEndSub

ランダム値の上限と下限は定数で決めておく。
Rnd関数のヘルプに次の表記があるので、これをそのまま使用している。

任意の範囲の整数の乱数を生成するには、次の式を使ってください。
Int((upperbound - lowerbound + 1) * Rnd + lowerbound)

出力結果の例はこちら

 1 : 71 
 2 : 54 
 3 : 58 
 4 : 29 
 5 : 31 
 6 : 78 
 7 : 2 
 8 : 77 
 9 : 82 
 10 : 71 

次に結果表示のコードを書く。
これはArrの中身を出力するだけ。
初回の結果と区切るために、String関数で区切り線(ハイフン20個)を出力している。

Sub MStart()'配列Arrの準備Dim Arr()AsLongConstMin=1,Max=10ReDim Arr(MinToMax)'配列Arrにランダム数を格納しながら出力For i =LBound(Arr)ToUBound(Arr)Const LowerBound =1, UpperBound =100
        Arr(i)=Int((UpperBound - LowerBound +1)*Rnd+ LowerBound)
        Debug.Print i; ":"; Arr(i)Next
    Debug.PrintString(20,"-")'■ここにソートのコードを書く'ソート結果表示For i =LBound(Arr)ToUBound(Arr)
        Debug.Print i; ":"; Arr(i)NextEndSub

この時点ではまだ何もソートしていないので、初回に出力されたランダム数がそのままもう一度出力される。

さて、次にソートのコードを書いていく。
前回のトランプのソートを図で表すと、次のようになる。赤が分割、緑がマージである。

これは再帰的な構造になっている。

分割するコード

さて、ではまず分割の部分を再帰で書いてみよう。
分割といっても配列を本当に2つに分けるわけではなく、添え字の開始値と終了値を設定することで特定範囲を表す。

次のコードは配列(Arr)と、添え字の開始値(Top)、添え字の終了値(Bottom)を受け取り、Middleを求めてさらに左と右に分けてMergeSortを呼び出す再帰コードである。

Sub MergeSort(Arr, Top, Bottom)'分割点Middleを求めるDim Middle AsLong
    Middle =(Top + Bottom) \ 2
    
    Debug.Print Top; "-"; Bottom
    
   '値が複数個あれば、さらにソートを呼び出すIf Top <> Bottom ThenCall MergeSort(Arr, Top, Middle)'左側のソートCall MergeSort(Arr, Middle +1, Bottom)'右側のソートEndIfEndSub

途中でわかりやすいようにTopからBottomを出力させている。
TopとBottomが一致したら、それは範囲が1つになったということで、再帰を停止する。
すると呼び出し元に戻り、今度は右側のソートに入る。

ちょうど以前に書いたフォルダの階層を辿るサンプルと似た動きをする。
thom.hateblo.jp

今回分を図示するとこんな感じ。

左、左、左、左、戻る、右、戻る、戻る、右、戻る、戻る、右、左、戻る、右、戻る、戻る、戻る、右、以下略

実際にMStartから呼び出してみる。
MStart自体の出力はコメント化しておいた。

Sub MStart()'配列Arrの準備Dim Arr()AsLongConstMin=1,Max=10ReDim Arr(MinToMax)'配列Arrにランダム数を格納しながら出力For i =LBound(Arr)ToUBound(Arr)Const LowerBound =1, UpperBound =100
        Arr(i)=Int((UpperBound - LowerBound +1)*Rnd+ LowerBound)'Debug.Print i; ":"; Arr(i)Next'Debug.Print String(20, "-")'ソート呼び出しCall MergeSort(Arr,LBound(Arr),UBound(Arr))'ソート結果表示For i =LBound(Arr)ToUBound(Arr)'Debug.Print i; ":"; Arr(i)NextEndSub

イミディエイトウインドウの出力はこうなる。

 1 - 10 
 1 - 5 
 1 - 3 
 1 - 2 
 1 - 1 
 2 - 2 
 3 - 3 
 4 - 5 
 4 - 4 
 5 - 5 
 6 - 10 
 6 - 8 
 6 - 7 
 6 - 6 
 7 - 7 
 8 - 8 
 9 - 10 
 9 - 9 
 10 - 10 

出力結果を配列の範囲に当てはめると次のようになる。

確かに左優先で呼び出されているのが分かる。

マージするコード

さて、これで分割部分はできたので、次にマージ部分を見ていく。
再帰から戻るときにマージが発生するので、コードは戻る部分に書いていく。

マージの各部分を見ていくと、前段階でグループ内がソート済みなので先頭から順に拾っていくだけでマージできることが分かる。

交互になっているのはたまたま。
数字を替えてみると、こういうのもありえる。

それでも各グループの先頭からしかとらないのは分かる。

もしこれが未ソートなら、数字を飛ばしたり戻ったりしないといけないので結局バブルソートと変わらないスピードになってしまう。

さて、次は並び替え用にもう一つ配列を用意する。
ArrをそっくりそのままコピーしてArr2を用意し、Arr2からArrへ並べながら転記していく為だ。
また、左グループと右グループをマージするので、それぞれの先頭を指すカウンタ(LC、RC)と、メイン配列への転記位置を指すカウンタ(C)を準備しておく。

Sub MergeSort2(Arr, Top, Bottom)'分割点Middleを求めるDim Middle AsLong
    Middle =(Top + Bottom) \ 2'値が複数個あれば、さらにソートを呼び出すIf Top <> Bottom ThenCall MergeSort(Arr, Top, Middle)'左側のソートCall MergeSort(Arr, Middle +1, Bottom)'右側のソートEndIf'並び替え用のコピーを確保する。Dim Arr2 AsVariant
    Arr2 = Arr
    
    LC = Top   '左側のカウンタ
    RC = Middle +1'右側のカウンタ
    C = Top'メイン配列のカウンタ'(2)へつづく

そして、左右のグループの先頭のどちらが小さいか比較しながら、小さい方を取得し、取得した方のカウンタとメインのカウンタを進める。

'(2)'左と右の小さい方を取得しながら、コピーしたArr2からArrへ転記DoWhile LC <= Middle And RC <= Bottom
        If Arr2(LC)> Arr2(RC)Then
            Arr(C)= Arr2(RC)
            RC = RC +1Else
            Arr(C)= Arr2(LC)
            LC = LC +1EndIf
        C = C +1Loop'(3)へ続く

これだけだと、片側のグループが空になったら転記が終わってしまうので、それぞれの残りを出力するためのループを書く。
片側しか残らないはずなので、ループは片方しか実行されない。

'(3)'以下のループはどちらか片方しか実行されない。'右側の残りがあれば全て転記DoWhile RC <= Bottom
        Arr(C)= Arr2(RC)
        RC = RC +1
        C = C +1Loop'左側の残りがあれば全て転記DoWhile LC <= Middle
        Arr(C)= Arr2(LC)
        LC = LC +1
        C = C +1LoopEndSub

以上でマージソートのコードが完成。

完成コードの全体

Sub MStart()'配列Arrの準備Dim Arr()AsLongConstMin=1,Max=10ReDim Arr(MinToMax)'配列Arrにランダム数を格納しながら出力For i =LBound(Arr)ToUBound(Arr)Const LowerBound =1, UpperBound =100
        Arr(i)=Int((UpperBound - LowerBound +1)*Rnd+ LowerBound)
        Debug.Print i; ":"; Arr(i)Next
    Debug.PrintString(20,"-")'ソート呼び出しCall MergeSort(Arr,LBound(Arr),UBound(Arr))'ソート結果表示For i =LBound(Arr)ToUBound(Arr)
        Debug.Print i; ":"; Arr(i)NextEndSub

Sub MergeSort(Arr, Top, Bottom)'分割点Middleを求めるDim Middle AsLong
    Middle =(Top + Bottom) \ 2'値が複数個あれば、さらにソートを呼び出すIf Top <> Bottom ThenCall MergeSort(Arr, Top, Middle)'左側のソートCall MergeSort(Arr, Middle +1, Bottom)'右側のソートEndIf'並び替え用のコピーを確保する。Dim Arr2 AsVariant
    Arr2 = Arr
    
    LC = Top   '左側のカウンタ
    RC = Middle +1'右側のカウンタ
    C = Top'メイン配列のカウンタ'左と右の小さい方を取得しながら、コピーしたArr2からArrへ転記DoWhile LC <= Middle And RC <= Bottom
        If Arr2(LC)> Arr2(RC)Then
            Arr(C)= Arr2(RC)
            RC = RC +1Else
            Arr(C)= Arr2(LC)
            LC = LC +1EndIf
        C = C +1Loop'以下のループはどちらか片方しか実行されない。'右側の残りがあれば全て転記DoWhile RC <= Bottom
        Arr(C)= Arr2(RC)
        RC = RC +1
        C = C +1Loop'左側の残りがあれば全て転記DoWhile LC <= Middle
        Arr(C)= Arr2(LC)
        LC = LC +1
        C = C +1LoopEndSub

ソートのテストコード

Arrが正しくソートされていない場合は中断モードに入るようなテストを書いてみた。

Sub TestSorted(Arr)For i =LBound(Arr)ToUBound(Arr)-1
        Debug.Assert Arr(i)<= Arr(i +1)NextEndSub

MStartの最後に呼び出すとちゃんとソートされているか分かるので便利。

マージソートの存在意義

実装が簡単なバブルソート、最も高速なクイックソート。
最初は、これ以外に何が必要なんだろうかと思っていた。

マージソートの存在意義を理解するのは、ソートの安定性という概念である。
例えば、Excelの表を氏名で並び替えた後に都道府県で並び替えると、都道府県順で並び、各都道府県の中身は氏名順に並んでいる。
これが安定ソートだ。

クイックソートは確かに早いが、不安定ソートである。
もしExcelの並び替えがクイックソートで実装されていたら、都道府県順に並び替えたときに氏名の順は無視され、バラバラになってしまう。
安定版のクイックソートというのもあるにはあるけれど、複雑になり、あまりクイックじゃなくなってしまう。

バブルソートは安定ソートである。実装も簡単だ。しかし、データ量が増えると致命的に遅い。

マージソートは、安定かつそこそこ早いソートなのである。
デメリットとしてはややメモリを食うこと。

理由はコレだ。

'並び替え用のコピーを確保する。Dim Arr2 AsVariant
    Arr2 = Arr

都度破棄されるので、大した量ではないが、元の配列が相当に大きい場合は気にする必要が出てくるかもしれない。

まぁ、なんでも自前主義というのは良くないので、普段は素直にExcelのソート機能を使えば良いけれど、プログラミングのスキルアップにはちょうど良いので興味のある方は自分の得意な言語で実装してみると良いと思う。

それにVBAだと、オブジェクトのコレクションをソートするような場合は自分で実装する必要があるので全く無駄ということもない。

安い靴を履いていた頃

私が社会人1年目の頃に履いていたのは5～7千円クラスのもの。
5千円以下になると明らかに履き心地が悪く、私の場合は履き慣れるまでは踵が擦れたり、指が当たって痛かったりと色々と不都合が出る。ようやく足になじんだ時にはすでにボロボロだ。
新品の頃はゴム臭がきつく、古くなるとカビ臭くなる。1足を毎日履いて、特に磨いたりもしなかったので、3カ月くらいで履きつぶしていた覚えがある。

靴の製法の違い

さて、靴といっても色々な製法がある。違いは、表革と底をくっつける手法。
3千円～1万円くらいの靴は、殆どがセメンテッド製法といわれる、いわゆる接着剤でくっつける方式。
工場で大量生産できるが、ムレやすい、つまりカビが発生しやすい、底の張り替えができないというデメリットがあるらしい。
その代り、水が浸入しにくいので、雨の日には最適。
セメンテッド製法の靴がすべて安物というわけではない。

次に縫い靴。主にマッケイ製法と、グッドイヤーウェルト製法がある。
マッケイは表革と底を直接縫い合わせたものだ。縫い靴なので底を完全交換できるが、1回が限度とのこと。

グッドイヤーウェルト製法は、間に1枚細い革(ウェルト)をかませたもので、表革はウェルトと縫い合わされ、底もウェルトと縫い合わされている。そのため、何度も底の縫い替えが可能だ。縫い直すたびに痛むのはウェルトなので、ウェルトを交換してしまえばリセットできる。

8年目の靴

さて、これが購入から8年目を迎えた靴。

といっても普段は3足でローテしているので、実質履いたのは2.5年分くらいだろうか。

まだまだ現役である。
グッドイヤーの靴は大事にメンテナンスすれば一生履けるらしい。
ただし、一番安いものでも3万くらいはする。

底も革なので、雨の日に履くとすぐすり減ってしまう。雨の日も結構使ったので、3年目くらいで1回オールソール(底の縫い替え)をしている。天気を選べば4年くらいは持つ。
オールソールのときにゴムか革かを選べるのだが、革の方が柔らかく、若干履き心地が良い気がするので、革底にした。
革底は擦り減りやすいので、コスパだけ考えるならゴム底が良い。

コストパフォーマンス

1万5千円くらいの靴を毎年買い替える場合と、3万円の靴を4年に1回底交換する場合で10年経過後を比較すると、ちょうど同額になる。

初期費用の差が大きいので、さらに履き続けた場合は底交換の方が安くなる。
それに、1万円台の靴と3万円台の靴では、履き心地も全然違う。最初からどこも痛くならないし、2～3日履けば足になじみ、特有のゴム臭もせず、革の良い香りがする。

ハンパに高い靴を買うくらいなら、初期投資でドンと3万出しといたほうが安上がりで快適。

逆に3万以上になるとあとは趣味の世界なので、コスパは3万くらい(グッドイヤーの最安ライン)がベスト。

いきなり9万は厳しいので、社会人2年目の終わり頃までは1足だけ良い靴を買って、あとは履きつぶし用と使い分けていた。

メンテナンス

長持ちさせるにはシューキーパーは必須。
私が買ったのはコロンブス社のもの。

[コロンブス] columbus HGレッドシダーシュートリー HGRCST (25.5)

• 出版社/メーカー: columbus(コロンブス)
• メディア: Shoes
• この商品を含むブログを見る

安物でも良いが、レッドシダー(赤杉)で作られたものを選ぶと良い。
レッドシダーは防虫、吸湿、消臭の効果があり、履き続けた靴が全然臭くならない。
ニスでコーティングされたものは見た目は良いけど、吸湿効果が無いので、おススメしない。

あとは適当にクリームいれて、サボらずに磨けばびっくりするくらい長持ちする。

私が使ってるメンテナンスグッズ

↓これは汚れ落としと革に潤いを与えるためのローション。まずこれでサッと靴を拭く。

(サフィール) SAPHIR ユニバーサルレザーローション 150ml 【並行輸入品】

• メディア:ウェア&シューズ
• この商品を含むブログを見る

それから、こんな感じの小さいブラシ↓で、

ペネトレィトブラシ　2個セット

• メディア:ウェア&シューズ
• この商品を含むブログを見る

このクリームを靴全体に薄く塗って

(サフィール) SAPHIR 保革 艶出し ビーズワックスファインクリーム 01：ブラック 【並行輸入品】

• メディア:ウェア&シューズ
• この商品を含むブログを見る

豚毛ブラシで余計なクリームをサッと取り除く。

[ぺダック] pedag 豚毛ブラシ ArtNo.8152 (BrownF)

• 出版社/メーカー: pedag
• メディア:ウェア&シューズ
• この商品を含むブログを見る

あとは適当な古着の切れ端かなんかで磨く。

失敗談

さて、実は4足持っていたのだが、うち2足は底交換の時期にきておりベンチ入り。また、1足はフィッティングミスで、履くと小指が痛むのでベンチ入り。そのため、最近は雨の日用の1足に負荷が集中していた。

雨の日用の靴も、スコッチグレインのグッドイヤー(表革は撥水加工、底はゴム)なのだが、撥水加工されているせいか、磨いても他の靴ほど光らない。あまり磨き甲斐のないヤツなのだ。まぁただ雨でも履けるし、ゴム底だから摩耗しにくいので便利は便利。

雨の日用の靴はいつの間にか履きつぶし用になっていた。そして7年目に表革にヒビが入り、リタイア。シューキーパーも使わず、クリームも入れずに履いてたらさすがにそうなるわな。。

アウトレットで安く入手する

先週の日曜は関西空港の手前にある、りんくうタウンプレミアムアウトレットに行ってきた。

南海電車なんば駅から、1,000円分の買い物クーポン付で往復2,010円。
www.nankai.co.jp

私の住んでいる東大阪からだと結構電車賃がかかってしまうので、事前に価格帯を電話で問い合わせた。税別で1万6千(ゴム底)～3万(革底)くらいとのこと。

直営店だと一番安くても2万8千円なので、これは安い。
1万6000円で外羽ストレートチップを1足購入した。

※ただし、アウトレットだとかなり品揃えは限られるので、サイズとデザインを伝えて在庫具合を確認してから行くと良い。

履かなくなった靴を売る

私は他人の履いた靴を買うという感覚が分からないので、まさか売れると思ってなかったが、グッドイヤー製法の靴は修理して履き続けることができるため、状態が良ければ売れる。

売ったのは例のフィッティングミスした靴で、1年くらいは我慢して履いたけれど、それ以来たまにしか履かなくなったもの。
購入価格が28,000円、売却は3,900円だった。底が少しすり減っており、中に足形が残っていたので、値がついたことに驚いている。

ネットで見つけた意見としては、共用施設のサンダルと同じ感覚で別に気にならないとのこと。
むしろ靴下を履く分トイレのサンダルよりマシで、クリーニングされていれば何も問題ないとのこと。

中古靴は8～9千円で販売されているようなので人の履いた靴でも気にならない人はトライしてみても良いかもしれない。

ちなみに、私は他人の履いた靴を買うのは嫌だ。

余談：靴のデザイン

プレーン、ストレート、Uチップ、ウイングチップ、ツーシームなど色々あるけど、冠婚葬祭で最もベターで、ビジネスにも使えるオールラウンダーは黒の内羽根ストレートチップ一択。(紹介した8年目の靴と同じデザイン)
最初の一側は黒の内羽根ストレートにしよう。あとはお好みで。

スコッチグレインのアシュランスがおススメである。アウトレットで自分にあうサイズがあればラッキーだ。

スコッチグレイン（SCOTCHGRAIN ASHLANCE 3526 BLACK 26cm）

• メディア:ウェア&シューズ
• この商品を含むブログを見る

式が評価されるプロセス

さて、実際に簡単なプログラムコードを使って評価のプロセスを見ていく。
繰り返しになるが、ここでいう評価とは何らかの操作を行って式の値を確定することである。何らかの操作とは、計算かもしれないし、結合かもしれないし、参照かもしれない。それらをひっくるめて言い表せる便利な言葉なのだ。

x =(1+1)*2

m =Left("Hello, World!",7)&StrConv("vba",vbUpperCase)

m ="Hello, "&StrConv("vba",vbUpperCase)となる。

m ="Hello, "&StrConv("vba",1)となる。

m ="Hello, "&"VBA"となる。

m ="Hello, VBA"となる。

ThisWorkbook.Sheets(1).Range("A1").Value=1

Sub test()Dim WB As Workbook
    Set WB = Workbooks.Open("C:\Work\test.xlsx")
    WB.Sheets(1).Range("A1").Value=1
    WB.Save
    WB.CloseEndSub

Dim WB As Workbook

Set WB = Workbooks.Open("C:\Work\test.xlsx")

WB.Sheets(1).Range("A1").Value=1

WB.Save

WB.Close

Sub test2()Dim R As Range
    Set R = Workbooks.Open("C:\Work\test.xlsx").Sheets(1).Range("A1")
    R.Value=1
    R.Parent.Parent.Save
    R.Parent.Parent.CloseEndSub

おわりに

さて、今回は「式の評価」という言い回し・概念について詳しく解説した。これはつまり、コードがやっていることを的確に表現する言葉を手に入れたということである。

新しい概念を獲得し、言葉によってそれを脳内辞書にマッピングしておく。回りくどいようだが、私はそれが物事の理解への早道になると信じている。今回の記事が読者のプログラミング上達の一助になれば幸いである。

なお、今回最後に紹介したコードはあくまでオブジェクト式の評価のプロセスを説明するためのサンプルなので、実務で参考にすべきコードではないということを改めて断っておく。何事もシンプルが一番である。

以上

なぜ自動補完が利かないのか

実はExcelシートの種類はワークシートだけではない。
適当なシートのツマミを右クリックして挿入メニューを選ぶと、4種類のシート種類が出てくる。

たとえばグラフシートにはRangeやCellsなどのプロパティが存在しない。
VBAコンパイラはプログラムが記述される段階ではSheets(1)がどのタイプのシートか判別できないため、一旦汎用的に利用できるObject型として取り扱う。そのため、前述の入力補完が利用できないのだ。

VBAコンパイラにとってObject型というのは実際に動かしてみるまでどんなオブジェクトなのかわからない謎のオブジェクトである。（それゆえに何のオブジェクトでも入れられるのだが）

謎のオブジェクトが持つRangeプロパティは、ExcelのRangeオブジェクトであるとは限らない※。オブジェクト型であるかどうかもわからず、ただの値かもしれないし、そんなプロパティ自体そもそも存在しないかもしれないのだ。
※たとえばWordのDocumentオブジェクトもRangeプロパティを持っており、こちらはExcelのRangeとは別物である。

VBAコンパイラがオブジェクトの中身を保障できない以上、馴染みのRangeという名称が登場してもそのRangeがValueやInteriorなどのプロパティを持っているなどと、どうして言い切れるだろうか。
だから、ValueやInterior.Colorなども候補表示できない。だいいち、候補に表示しておいてそこから選んだ結果がエラーになったらみんな怒るだろう。
VBAエディタはそんな無責任なことはしないのだ。

VBAコンパイラが型を認識している場合、間違った記述をすると実行の前のコンパイルでエラーになる。下図では赤線のThisWorkbookがWorkbook型であると認識されているため、「Workbook型にそんなプロパティはないよ」というのを予め教えてくれるわけだ。

ところが、VBAコンパイラが型を認識していない場合、間違った記述をしても実行するまではエラーにならない。
以下の場合はコンパイルエラーではなく、実行時エラーになる。

Ahahahahahahhaなんていうプロパティは一目でオカシイと分かりそうなものだが、コンパイル段階で指摘してくれないのはなぜだろうか。

これは、赤線の部分がObject型(つまり謎のオブジェクト)として認識されるため、Ahahahahahahhaというプロパティが存在するか存在しないかはっきりしないからだ。

いや、まあ、たぶんオカシイんだけどその気になれば自作クラスにAhahahahahahhaって名前のプロパティを実装することはできるので、VBエディタは無責任にコンパイル段階でオカシイなどと指摘するわけにいかない。

で、実行時に「試してみたけど(やっぱり)そんなプロパティなかったよ」ってことである。

入力候補を自動補完させる方法

Sub Sample()Dim WS As Worksheet
    Set WS = Workbooks.Open("C:\Work\test.xlsx").Sheets(1)
    WS.Range("A1").Value=1
    WS.Parent.Save
    WS.Parent.CloseEndSub

WorksheetsプロパティとSheetsプロパティの違い

Workbookオブジェクトには、Sheetsプロパティの他にWorksheetsプロパティも存在する。
これを使えば最初からWorksheet型になりそうなものであるが、残念ながらそうはならない。

Sheetsプロパティはすべての種類のシートを含むSheetsオブジェクトを返す。
Worksheetsプロパティはすべてのワークシートを含むSheetsオブジェクトを返す。

つまり、Worksheetsプロパティはワークシート型のシートだけを返すのだが、どちらもSheetsオブジェクトなのだ。
Sheetsオブジェクトのデフォルトプロパティに引数としてシート番号を渡すと、シートがObject型として返るという仕組みである。

以下のコードで、もう少し具体的にみていこう。

ThisWorkbook.Sheets(1).Range("A1").Value=1

上記コードはまずThisWorkbookが評価されてWorkbookオブジェクトになる。

【参考】評価という言葉に引っかかったらこちら。
thom.hateblo.jp

Workbookオブジェクト.Sheetsプロパティが評価され、Sheetsオブジェクトになる。
Sheets(シート番号)は実際には、Sheets.Item(シート番号)の短縮系である。

短縮せずに書くならこうなる。

ThisWorkbook.Sheets.Item(1).Range("A1").Value=1

※厳密にはItemではなく[_Default]という特殊なプロパティなのだが、話がややこしくなるのでここではItemとしておく。

さて、Sheetsオブジェクト.Itemプロパティ(1)が評価されると1番目のシートオブジェクトになる。しかし、Worksheetオブジェクトになるか、それともChartオブジェクト(グラフシート)になるかは実行してみるまでわからないので、Object型として扱われる。

Worksheetsプロパティを使用した場合はワークシート型のシートだけが選別されるが、結局Sheetsオブジェクトを返す時点で、そのデフォルトプロパティがシートをObject型として扱うため、以降の自動補完はされない。

プロパティ名と、そのプロパティが返すオブジェクト名の関係はちょっとややこしいので以下にまとめておく。

• SheetsプロパティはSheetsオブジェクトを返す。
• WorksheetsプロパティもSheetsオブジェクトを返す。
• Worksheetsという名称のオブジェクトは存在しない。
• Worksheetオブジェクトは存在するが、Sheetオブジェクトは存在しない。

※sの有無に気を付けて。

以上

呼び出しのパターン

以下にカッコの有無でパターンを洗い出してみた。

【個別引数にカッコをつけて呼び出し】

[1] プロシージャ名 (引数1)
[2] プロシージャ名 (引数1), (引数2)
[3] プロシージャ名 (引数1), (引数2), (引数3)

【個別引数にカッコをつけずに呼び出し】

[4] プロシージャ名 引数1
[5] プロシージャ名 引数1, 引数2
[6] プロシージャ名 引数1, 引数2, 引数3

【引数全体にカッコをつけて呼び出し】

[7] Call プロシージャ名(引数1)
[8] Call プロシージャ名(引数1, 引数2)
[9] Call プロシージャ名(引数1, 引数2, 引数3)

【個別引数と、引数全体にカッコをつけて呼び出し】

[10] Call プロシージャ名 ((引数1))
[11] Call プロシージャ名 ((引数1), (引数2))
[12] Call プロシージャ名 ((引数1), (引数2), (引数3))

【NGパターン】

[13] プロシージャ名 (引数1, 引数2)
[14] Call プロシージャ名 引数1, 引数2

こうして並べてみると、例外などではなく、一本きれいなルールが通っているのがわかる。

全体カッコの意味

以下のように全体カッコを外して書いても文法上は一見問題なさそうに見える。

Call プロシージャ名 引数1, 引数2, 引数3

ではVBAコンパイラはなぜこれをエラーとみなすのだろうか。
Callだと問題が見えてこないので、基本ルールの「戻り値を利用する場合」で検証してみよう。

以下の命令をどう解釈すべきだろうか。

プロシージャA プロシージャB 引数1, 引数2, 引数3

上記のようにカッコがない場合、解釈が次の3通りに分かれてしまう。

[1] プロシージャA プロシージャB(引数1), 引数2, 引数3
[2] プロシージャA プロシージャB(引数1, 引数2), 引数3
[3] プロシージャA プロシージャB(引数1, 引数2, 引数3)

引数全体にカッコを付けるのは「ここまでがプロシージャXの引数なので、先に評価してくださいね」とコンパイラに教えてあげる意味があるのだ。

Callの場合は人が見たら問題なさそうに見えるが、コンパイラはプロシージャの引数の範囲を柔軟に判定してくれるということはないので、やはりカッコが必要である。

個別カッコの意味

個別の引数につけるカッコにも非常に重要な意味がある。
VBAはデフォルトでは、プロシージャへの引数を参照渡しする。

下記のようにカッコなしでTwice aと書くと、変数aの参照が渡され、それが2倍されるので、最終的に20が表示される。

Sub Sample()
    a =10
    Twice a
    MsgBox a
EndSubSub Twice(x)
    x = x *2EndSub

ところが、個別のカッコをつけると引数が値渡しになるのだ。
次のコードではTwiceへは単に10が渡されるので、Twiceプロシージャでそれを2倍したところでSampleプロシージャの変数aは相変わらず10のままである。

Sub Sample()
    a =10
    Twice (a)MsgBox a
EndSubSub Twice(x)
    x = x *2EndSub

ただし、Call Twice(a)とすると、そのカッコは引数全体を囲むカッコとみなされ、aは参照渡しになる。

Sub Sample()
    a =10Call Twice(a)MsgBox a
EndSubSub Twice(x)
    x = x *2EndSub

さらにカッコで囲むと、外側のカッコは引数全体のカッコ、内側のカッコは値渡しを表す個別カッコになる。

Sub Sample()
    a =10Call Twice((a))MsgBox a
EndSubSub Twice(x)
    x = x *2EndSub

整理すると、以下の3パターンでは、[1]と[2]は参照渡しになるが、[3]は値渡しになってしまう。
[1] プロシージャ a
[2] Call プロシージャ(a)
[3] プロシージャ (a)

パターン[3]について、「例外として引数が一つの場合はカッコを付けることができる」という理解では、思わぬバグにつながることがあるということだ。

なぜ個別カッコは値渡しなのか

ふつう、値渡しをするには呼び出されるプロシージャ側でByValを使用する。
なんで個別カッコが値渡しになるという変なルールがあるのだろうか。

これはあくまで私の推測であるが、これも例外的なカッコの使い方ではなく、「カッコ内は先に評価する」という基本ルールに則って、結果的に値渡しになっているだけではないかと思う。

つまり、たとえば (5 + 2) * 3 と書いたときに5 + 2が先に評価されて7になるのと同じ理屈である。

先ほどのコードでは、(a)が評価されて10になった後に渡されるから、値渡しになる。

そう考えると不可解で例外的に思えるルールも、実は例外ではなく評価の大原則に基づいた至極当然な結果であるといえる。

あくまで推測であるが。

あとがき

プロシージャ (a)と書くと、そのカッコは引数全体のカッコではなく個別カッコなので値渡しになってしまう。
呼び出し先がByRefで待ち受けていても、値渡しになってしまう。
なぜならすでに呼び出し元で先に評価されて、値になってしまっているから。

参照渡しを想定している場合は、個別カッコを付けるとバグの元になるということをしっかり押さえておきたい。

今回の事実をテクニックとして使うのはお勧めしない。
基本は「Callを書く場合と、戻り値を利用する場合にカッコを付け、それ以外では(たとえ付けられても)付けてはいけない」という原則に忠実に、値渡しか参照渡しかは呼び出し先のプロシージャのByValまたはByRefで制御するのが良い。

VBAの書籍やネットの情報ではで引数のカッコについて細部まで説明しているものが見つけられなかった。
「例外」として説明しているか、そもそも基本ルール以外の説明がないケースが多い。

※ちゃんと探せばあるのかもしれない。

私はVBAではなく、WSHの書籍で今回の事実を知った。

WSHクイックリファレンス 第2版

• 作者:羽山博
• 出版社/メーカー:オライリー・ジャパン
• 発売日: 2006/10/24
• メディア:単行本（ソフトカバー）
• 購入: 2人 クリック: 64回
• この商品を含むブログ (22件) を見る

さすがオライリー。
ちなみに購入目的は、VBSをやりたかったわけではなく、FileSystemObjectやDictionaryなど、VBAからも便利に使用できるMicrosoft Scripting Runtime系のオブジェクト仕様を抑えておくため。

VBAのテクニック集などにも申し訳程度にFileSystemObjectの使用方法は掲載されているが、Microsoft Scripting RuntimeはWSHが本家なので、詳しく仕様を知りたいときはこちらがおすすめ。

パームレスト

私は普段からプログラミングの学習やブログの執筆などでキーボードを良く使う。
それで結構いい値段のキーボードを使っているのだが、パソコン専用のローデスクを使うようになってから今一つ入力しづらい。

スライド式のキーボードテーブルは、これ以上引き出すことができないため、腕を置く場所がない。仕方なくキーボードの下のわずかなスペースに手を置いて入力してたのだが、上端にあるキーが押しづらく、入力のたびに若干手を持ち上げる必要がある。ネットサーフィンくらいならそれでも十分だけれど、長文を書いていると結構疲れるのだ。

そこで、こちらのパームレストを買ってきた。

FILCO ウッドパームレスト Mサイズ 幅(360mm) 天然堅木製 オスモカラー仕上げ 日本製 ブラウン FWPR/M

• 出版社/メーカー:FILCO
• 発売日: 2013/05/01
• メディア: Personal Computers
• この商品を含むブログを見る

使用しているキーボードのメーカーの純正品である。使っているキーボードに合わせて作られたものなので高さがちょうど良い。
結構値は張るけどネットで評判が良く、天然木ならではの高級感もあるのでまあ仕方がない。

以下、設置してみたところ。

ぎりぎりキーボードテーブルに収まった。

パームレストはクッション性を売りにした製品が多いのだが、モノによっては安定感がなくて入力しづらいという意見もあるが、こちらの製品は言ってしまえばただの木の板なので安定感は抜群。さらに、パームレストを滑るように手を動かすことで、遠くのキーでも楽々押せてしまう。

不便に慣れてしまうとなかなか気づかなくなるものだが、実はそのせいで肩が凝ったり入力の効率が落ちているかもしれない。一度、パームレストの代わりに本か何かを置いてみて、入力が楽になるようだったら購入を検討しても良いかもしれない。

パとバを間違えないフォント

さて、次は快適なフォントである。
私は日本語を「かな入力」でタイプしているので、濁点と半濁点を押し間違えることがある。先日もプログラムと書こうとしてブログラムと書いてしまった。

ローマ字入力なら間違えようがないのだが、一打で一文字の「かな入力」は慣れるとすこぶる快適で、今さらローマ字に戻れない。

そこで、半濁点がかなり大きい「Migu 1M」というフォントをダウンロードしてきた。
Miguフォント : M+とIPAの合成フォント

これなら見間違えようがない。

これをエディタのフォントに設定する。
※私はVimを使用するので、以下のように設定した。

set guifont=Migu_1M:h12

アンチエイリアス

しかし、これだけだとVimで表示したときに表示が汚い。
こんな感じ。

拡大してみると、線の太さがまちまちで醜い。

そこで以下の記事を参考にさせていただき、Vimを綺麗に変身させる。
74th.hateblo.jp

できたのがこちら。

拡大しても、線の太さが均一で美しい。

なんか前にもこんな設定をした気がするのだが、メインPCが壊れてしまったのでどちらにしても再度環境構築である。

普通にマクロを組む場合

まず普通にマクロを組む場合について考えてみよう。

VBAのコードに落とし込むには、

「まず記入するのはこのブックのひとつ目のシートだから、ThisWorkbook.Sheets(1)、ひとつ目の商品があるのはシートの5行目、品名はC列だから、Range("C5")に"パソコン"と記入し、単価はD列、個数はE列だからRange("D5")に100000、Range("E5")に40と記入する。」

という風により具体的に考える必要が出てくる。

具体的なコードは次のようになる。

Sub注文記入()Dim RecordRow AsLong
    RecordRow =5With ThisWorkbook.Sheets(1).Range("C"& RecordRow).Value="パソコン".Range("D"& RecordRow).Value=100000.Range("E"& RecordRow).Value=40EndWith
    
    RecordRow =6With ThisWorkbook.Sheets(1).Range("C"& RecordRow).Value="複合機".Range("D"& RecordRow).Value=1500000.Range("E"& RecordRow).Value=2EndWithEndSub

VBAに慣れた人ならすこぶる簡単なコードに見えるだろう。
しかし実際には脳内では、「人間がやりたいこと」と、「VBAでの具体的なコード」の対応表が作られており、いくらVBAが得意な人でもコードが複雑になってくると脳内の対応表がオーバーフローを起こす。
あるいは久々に読んでみたら、そのコードが何をしたかったものなのかさっぱり思い出せないということがよくある。

コードの抽象度

人間にとって次の指示は非常に具体的である。
「注文票の、ひとつ目の商品名は"パソコン"で、単価は10万円、個数は40個。二つ目の商品は"複合機"で、単価は150万円、個数は2個。」

しかしコンピューターにとっては上記の指示は非常に抽象的である。
もしそんな指示を与えたら、「注文票って何？どのブックの何番目のシートのこと？ひとつ目ってシートの1行目でいいの？、商品名の列は？ってかそもそも列なの？もっと具体的に言って！！！」という具合に混乱(エラー)を起こす。

普通、抽象的な話というのは分かりにくいものなのだが、VBAのコードは人間にとっては具体的過ぎて難しいので、「抽象的なコードのほうがわかりやすい」という反転現象が起こる。

【参考】
thom.hateblo.jp

抽象的な書き方

冒頭で紹介したVBA風のコードであるが、実はちゃんとしたVBAコードである。
これ単体ではもちろん動かないが、他にいろいろとコードを書いて準備すれば、以下は有効なコードになる。

Sub注文記入()With注文票.注文(1).品名 ="パソコン".単価 =100000.個数 =40EndWithWith注文票.注文(2).品名 ="複合機".単価 =1500000.個数 =2EndWithEndSub

以下、その準備について記す。

まずは注文票シートのオブジェクト名を「注文票」に変更する。

【参考】
thom.hateblo.jp

次に、クラスモジュールを挿入し、オブジェクト名を「I注文レコード」、Instancingを「2 - PublicNotCreatable」にする。

「I注文レコード」のIはインターフェースの意味である。
インターフェースは、メソッドやプロパティの存在を担保するためのモジュールで、プロシージャの形式だけを記入して中身は記入しない。

I注文レコードには、次のコードを記入しておく。
この時点ではインターフェースを使用する意味が分からないかもしれないが、最後に説明するので今は気にしないでほしい。

PropertyLet品名(x AsString)EndPropertyPropertyLet個数(x AsLong)EndPropertyPropertyLet単価(x AsLong)EndPropertySubClear()EndSub

次にもう一つクラスモジュールを作成し、こちらはオブジェクト名を「注文レコード」、Instancingはデフォルトの「1 - Private」のままにしておく。

注文レコードのコードは次のとおり。

Implements I注文レコード
Public ws As Worksheet
Public RecordRow AsLongPropertyLet Number(N AsLong)
    RecordRow = N +4EndPropertyPropertyLet I注文レコード_品名(x AsString)
    ws.Range("C"& RecordRow).Value= x
EndPropertyPropertyLet I注文レコード_個数(x AsLong)
    ws.Range("E"& RecordRow).Value= x
EndPropertyPropertyLet I注文レコード_単価(x AsLong)
    ws.Range("D"& RecordRow).Value= x
EndPropertySub I注文レコード_Clear()Me.I注文レコード_個数 =0Me.I注文レコード_単価 =0Me.I注文レコード_品名 =""EndSub

【参考】
thom.hateblo.jp

そして最後に「注文票」シートのコードに次のコードを記入する。

PropertyGet注文(N)As I注文レコード
    Dim O AsNew注文レコード
    Set O.ws =Me
    O.Number = N
    Set注文 = O
EndProperty

ここで注目してほしいのは、注文票シートのプロパティ「注文」が、「I注文レコード」インターフェースを返す点である。
これは、InstancingがPrivateなオブジェクトをパブリックプロパティの引数や戻り値にすることはできず、エラーとなるためである。

具体的なオブジェクトは「注文レコード」型として作成している。
InstancingがPublicNotCreatableなクラスはNewでインスタンスを作ることができない。

そのためこのように自作クラスを引数や戻り値に使おうと思ったらインターフェースを使わざるを得ないのである。

さて、ここまで準備ができたら、あとは標準モジュールに冒頭のコードを書くだけだ。

Sub注文記入()With注文票.注文(1).品名 ="パソコン".単価 =100000.個数 =40EndWithWith注文票.注文(2).品名 ="複合機".単価 =1500000.個数 =2EndWithEndSub

このコードは次のように動作する。

まず「注文票」の「注文」プロパティ(以下のコード)に1が渡される。

PropertyGet注文(N)As I注文レコード
    Dim O AsNew注文レコード
    Set O.ws =Me
    O.Number = N
    Set注文 = O
EndProperty

すると、「注文レコード」オブジェクトが生成され、Numberプロパティが1にセットされる。
注文レコードクラス内では、Numberプロパティは次のように定義されている。

PropertyLet Number(N AsLong)
    RecordRow = N +4EndProperty

つまり1が渡されると、4が足され、5になる。

「ひとつ目の商品があるのはシートの5行目」というのを思い出してほしい。
ここでは、「何個目」という人間の管理する情報を「何行目」というExcelの管理する情報に変更している。

次に「.品名 = "パソコン"」である。
これはWith文の中にあるので、実際は「注文票.注文(1).品名 = "パソコン"」と同じ。

「I注文レコード」インターフェースの品名プロパティが参照されると、具体的にはそれが指す「注文レコード」オブジェクトの次のコードが呼ばれる。

PropertyLet I注文レコード_品名(x AsString)
    ws.Range("C"& RecordRow).Value= x
EndProperty

ここでwsは「注文票」シートを指す。
※「注文票」の「注文」プロパティで「Set O.ws = Me」として自分自身を渡している。

RecordRowは先ほど5がセットされているので、注文票のRange("C5")に引数xに入った"パソコン"が入力される。

単価や個数についても類似の動作なので割愛する。

以上が抽象的な書き方を実現するための、具体的なコードの準備である。

余計複雑になった気がする？

そのとおり。メインのコードをスッキリ書くために、周辺のコードは相当に複雑になっている。
しかし重要なのは、メインコードのロジックを書く際、その複雑さは脇に置いておけるということだ。

一度仕組みを作ってしまえば、シート番号や記入する行、品名を記入するべき列など、具体的な情報は一切考慮する必要はない。

もしこれから書くコードが50ステップにも満たない簡単なものであれば、こうしたテクニックは余計な複雑さを持ち込むだけであまり役に立たないだろう。

しかし、相当に複雑なロジックの巨大なマクロを書こうと思ったとき、複雑さを分離してメインロジックに集中できる仕組みは有難い。

あとがき

VBAのクラスモジュールは、以下のようなジレンマを抱えているように思う。
「メリットが分からないから使わない→使わないからメリットが分からない」
「使われないから書籍などで紹介されない→書籍などで紹介されないから使われない」

私がオブジェクト指向を理解したのは、実はVBScriptが最初だった。
「なんでまた。。」と思われるかもしれないけど、その当時私はVBSでAccess連携する複雑なコードを書いていた。
複雑で具体的な処理をぐちゃぐちゃ書いていて、ある日それは破綻した。
「どうしてエラーになるのかさっぱり分からない。細部を追っても、全体を見渡しても分からない。これ以上一歩も進めない。」
そう感じて一旦コードを整理しようと思って書き直した際に採用したのが、「クラス」だった。

だから皆さんも、自分のコードが複雑すぎて理解が追い付かなくなってきたら、クラスモジュールのことを思い出してほしい。それはきっと力になってくれるはずだ。

マクロの概要

変換のターゲットとするコードはこちら。

Sub hoge()Dim R As Range
    Set R = Selection
    With R
        .HorizontalAlignment = xlCenter
        .Value="ABC".Interior.Color =vbYellowWith.Font
            .Color =vbRed.Bold =TrueEndWithWith.Borders
            .LineStyle = xlContinuous
            .Color =vbBlueEndWithEndWithEndSub

上記のコードを、マクロを使って以下のように変換する。

Sub hoge()Dim R As Range
    Set R = Selection
    R.HorizontalAlignment = xlCenter
    R.Value="ABC"
    R.Interior.Color =vbYellow
    R.Font.Color =vbRed
    R.Font.Bold =True
    R.Borders.LineStyle = xlContinuous
    R.Borders.Color =vbBlueEndSub

実現方法を検討する

さて、どう実現するのか。
まず、コードはクリップボードから読み込み、イミディエイトウインドウに出力することにしよう。
VBAでクリップボードを扱うには、「Microsoft Forms 2.0 Object Library」を参照設定する必要がある。
あるいは、ユーザーフォームを挿入すると自動で参照設定される。

とりあえず、クリップボードにコピーしたコードをそのままイミディエイトウインドウに出力するコードを書いてみた。
ポイントは改行でSplitして配列Arrに格納しているところ。

Subとりあえず入出力()Dim CB AsNew DataObject
    CB.GetFromClipboard
    Dim Arr()AsString: Arr =Split(CB.GetText,vbCrLf)Dim s
    ForEach s In Arr
        Debug.Print s
    NextEndSub

次にWithで始まる文はそのまま出力せず、オブジェクト名を保持するように変更する。
そして、ドットで始まる文の先頭にオブジェクト名を付けていけばよい。

その通りに作ってみた。

Sub Withを外す()Dim CB AsNew DataObject
    CB.GetFromClipboard
    Dim Arr()AsString: Arr =Split(CB.GetText,vbCrLf)Dim s
    ForEach s In Arr
        IfLeft(Trim(s),4)="With"Then
            ObjectName =Right(Trim(s),Len(Trim(s))-5)ElseIfLeft(Trim(s),1)="."Then
            Debug.Print ObjectName &Trim(s)ElseIfTrim(s)="End With"Then'何もしないElse
            Debug.Print s
        EndIfNextEndSub

これで単体のWithならうまくいく。
ためしに以下をコピーして実行してみると、

Sub hoge()Dim R As Range
    Set R = Selection
    With R
        .HorizontalAlignment = xlCenter
        .Value="ABC".Interior.Color =vbYellowEndWithEndSub

このように、Withが外れて出力される。

Trimしているためインデントが消えているが、とりあえずできている。
しかし、冒頭のターゲットコードに対して実行してみるとうまくいかない。

入れ子になったWithの扱い方

Withが入れ子になっているコードにも対応させるべく、状態遷移図を使って考えてみよう。
まずWith文の外側をNoWithと定義する。

以下は、WithやEnd Withが実行されるたびにどのように状態が変化するのかを図示したものである。
図中の「With R」は、「With Rの内部にいる状態」を表す。

このように、行って戻ってくるような構造の場合、スタックを使って処理することができる。
スタックとは、下から上にデータを積み上げていく構造で、常に一番上のデータだけを取り出すことができる。
図示すると次のとおり。

VBAでスタックを実装

以前VBAでスタッククラスを作成したので、そちらを使いまわすことにした。
クラスモジュールを挿入し、オブジェクト名をStackとして以下のコードを張り付ける。

Private Items()AsVariantPropertyGetCount()AsIntegerCount=UBound(Items)EndPropertyPropertyGet Top()AsVariant
    Top = Items(UBound(Items))EndPropertyPublicFunction Pop()AsVariantIfUBound(Items)>0Then
        Pop = Items(UBound(Items))ReDimPreserve Items(UBound(Items)-1)Else
        Pop =EmptyEndIfEndFunctionPublicSub Push(ByRef x AsVariant)ReDimPreserve Items(UBound(Items)+1)
    Items(UBound(Items))= x
EndSubPrivateSub Class_Initialize()ReDim Items(0)EndSub

スタックに積む操作をPush、降ろす操作をPopという。また、Top命令で一番上のデータを参照することができる。

実際にサンプルを書いて見た。

Sub StackTest()Dim ObjectStack AsNew Stack
    ObjectStack.Push "R"
    Debug.Print ObjectStack.Top &".Test1"
    ObjectStack.Push "R.Font"
    Debug.Print ObjectStack.Top &".Test2"
    ObjectStack.Pop
    Debug.Print ObjectStack.Top &".Test3"
    ObjectStack.Push "R.Borders"
    Debug.Print ObjectStack.Top &".Test4"
    ObjectStack.Pop
    Debug.Print ObjectStack.Top &".Test5"
    ObjectStack.Pop
EndSub

実行するとこのように、スタックの先頭データと".TextX"が結合されて出力される。

R.Test1
R.Font.Test2
R.Test3
R.Borders.Test4
R.Test5

スタックを使ったWithを外すコード

前項で紹介したスタックを使ってWithを外すコードを作成する。
With文が出てきたらスタックにオブジェクト名をPushし、End Withが出てきたらPopすれば良い。

完成したコードがこちら。

Sub UnWith()Dim CB AsNew DataObject
    CB.GetFromClipboard
    Dim Arr()AsString: Arr =Split(CB.GetText,vbCrLf)Dim ObjectStack AsNew Stack
    
   '先に配列内の値をすべてトリムしておくDim i
    For i =LBound(Arr)ToUBound(Arr)
        Arr(i)=Trim(Arr(i))NextDim s, ObjectName
    ForEach s In Arr
        IfLeft(s,4)="With"Then
            ObjectName =Right(s,Len(s)-5)IfLeft(ObjectName,1)="."Then
                ObjectStack.Push ObjectStack.Top & ObjectName
            Else
                ObjectStack.Push ObjectName
            EndIfElseIfLeft(s,1)="."Then
            Debug.Print ObjectStack.Top & s
        ElseIf s ="End With"Then
            ObjectStack.Pop
        Else
            Debug.Print s
        EndIfNextEndSub

実行結果はこの通り

課題

インデントが消えてしまうのが難点だが、以前に自動でインデントを揃えるマクロを紹介したのでそれと組み合わせれば綺麗に作れそうだ。
thom.hateblo.jp

また、今回作成したUnWithマクロの課題として、ドットが文の中ほどにあるものは対応していない。
たとえば、選択されている四角いシェイプの面積を求める以下のマクロをコピーして実行すると、

Sub四角いシェイプの面積()Dim S As Shape
    Set S = Selection.ShapeRange(1)With S
        A =.Height *.WidthEndWith
    Debug.Print A
EndSub

以下のように出力される。

Sub 四角いシェイプの面積()
Dim S As Shape
Set S = Selection.ShapeRange(1)
A = .Height * .Width
Debug.Print A
End Sub

ドットの左にスペースまたは丸括弧が来るときは、親オブジェクトを挿入するなどの対処が取れそうだけれど、スペースと丸括弧以外は無いのだろうか。やるならもっと汎用的で確実な方法を採りたい。

そもそも単純変換してしまうと文字列中にあるドットにまで親オブジェクト名を挿入してしまう。

色々考慮する点はありそうだが、ステートメントの判定が複雑になりすぎる。
今は関数でごちゃごちゃやっているところも、別途ステートメントオブジェクトを作りたくなる。

今回とは逆の、With無しのコードをWith化するマクロも作ってみたいが、UnWithより難しそうなので一旦保留中である。

色々考えているうちに面倒くさくなってきたので今日はここまで。

作成するマクロの概要

まずはGIFアニメで楽々とフローを作成している様子を紹介。

プロセスボタンをクリックするとプロセス入力モードになり、あらかじめ用意された枠をクリックすることでプロセス名が入力できる。
コネクターボタンをクリックするとコネクター接続モードになり、プロセスを次々クリックしていくだけで矢印で接続される。
最後にチャートの完成ボタンをクリックすると、不要な枠が消え、まっすぐな鉤型コネクターは直線コネクターに変換されることでコネクターのズレも綺麗になる。

作り方

新しいブックに標準モジュール「Module1」を挿入し、以下のコードを張り付ける。

OptionExplicitPublicEnum Mode
    デフォルト =0消去 =2プロセス入力 =3コネクタ接続 =5判断入力 =4EndEnumPublicEnum Direction
    North =1
    West =2
    South =3
    East =4EndEnumPublic前にクリックしたシェイプ As Shape

PublicFunction反対方向(D As Direction)As Direction
    Dim ret As Direction
    If D <3Then
        ret = D +2Else
        ret = D -2EndIf反対方向 = ret
EndFunctionSubClick()Dim今クリックしたシェイプ As Shape: Set今クリックしたシェイプ _= Sheet1.Shapes(Application.Caller)If Sheet1.現在のモード <>コネクタ接続 ThenSet前にクリックしたシェイプ =NothingDimシェイプ文字列 AsStringSelectCase Sheet1.現在のモード
    Case Mode.消去
        Callシェイプ無効化(今クリックしたシェイプ)Case Mode.プロセス入力
        シェイプ文字列 =InputBox("入力してください")Ifシェイプ文字列 =""ThenExitSubCallシェイプ有効化(今クリックしたシェイプ)Callシェイプ変更(今クリックしたシェイプ, msoShapeFlowchartProcess)今クリックしたシェイプ.TextFrame2.TextRange.Text =シェイプ文字列
    Case Mode.判断入力
        シェイプ文字列 =InputBox("入力してください")Ifシェイプ文字列 =""ThenExitSubCallシェイプ有効化(今クリックしたシェイプ)Callシェイプ変更(今クリックしたシェイプ, msoShapeFlowchartDecision)今クリックしたシェイプ.TextFrame2.TextRange.Text =シェイプ文字列
    Case Mode.コネクタ接続
        IfNot前にクリックしたシェイプ IsNothingThenDimコネクタ As Shape
            Setコネクタ = Sheet1.Shapes.AddConnector(msoConnectorElbow,624,154,816,272)コネクタ.Line.EndArrowheadStyle = msoArrowheadOpen
            コネクタ.Line.Weight =1.5コネクタ.Line.ForeColor.RGB=vbBlackDim接続方向 As Direction
            接続方向 =方位判定(前にクリックしたシェイプ,今クリックしたシェイプ)コネクタ.ConnectorFormat.BeginConnect _
                ConnectedShape:=前にクリックしたシェイプ, _
                ConnectionSite:=接続方向
                
            コネクタ.ConnectorFormat.EndConnect _
                ConnectedShape:=今クリックしたシェイプ, _
                ConnectionSite:=反対方向(接続方向)EndIfSet前にクリックしたシェイプ =今クリックしたシェイプ
    CaseElseMsgBox"モードを選択してください。"EndSelectEndSubSubシェイプ有効化(sh As Shape)With sh
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB=vbBlack.Line.ForeColor.RGB=vbBlack.Line.Weight =2.Fill.Transparency =0.Line.DashStyle = msoLineSolid
        .Fill.ForeColor.RGB=vbWhiteEndWithEndSubSubシェイプ無効化(sh As Shape)With sh
        .AutoShapeType = msoShapeFlowchartProcess
        .Line.Weight =0.25.TextFrame2.TextRange.Delete.Line.ForeColor.RGB=RGB(150,150,150).Fill.Transparency =1.Line.DashStyle = msoLineDash
    EndWithEndSubSubひな形作成()Set前にクリックしたシェイプ =NothingCall全シェイプ削除
    Dim幅 AsDouble: 幅 =100Dim高さ AsDouble: 高さ =40Dim開始X AsDouble: 開始X =100Dim開始Y AsDouble: 開始Y =120Dim横間隔: 横間隔 =50Dim縦間隔: 縦間隔 =30Dim横数: 横数 =5Dim縦数: 縦数 =10Dim x, y
    For x =0To横数 -1For y =0To縦数 -1Dim sh As Shape
            Set sh = Sheet1.Shapes.AddShape( _Type:=msoShapeFlowchartProcess, _Left:=開始X +(x *(幅 +横間隔)), _
                Top:=開始Y +(y *(高さ +縦間隔)), _Width:=幅, _
                Height:=高さ)Callシェイプ無効化(sh)
            sh.OnAction ="Click"NextNextCall Sheet1.ボタン状態クリア
    Sheet1.現在のモード =デフォルト
EndSubSub全シェイプ削除()Dim s As Shape
    ForEach s In ActiveSheet.Shapes
        If s.Type<> msoFormControl Then'←ボタンを削除しないため
            s.DeleteEndIfNextEndSubFunction方位判定(s1 As Shape, s2 As Shape)As Direction
    Dim s1横中央: s1横中央 = s1.Left+(s1.Width/2)Dim s2横中央: s2横中央 = s2.Left+(s2.Width/2)Dim横の距離: 横の距離 = s1横中央 - s2横中央
    
    Dim s1縦中央: s1縦中央 = s1.Top +(s1.Height /2)Dim s2縦中央: s2縦中央 = s2.Top +(s2.Height /2)Dim縦の距離: 縦の距離 = s1縦中央 - s2縦中央

    IfAbs(横の距離)-Abs(縦の距離)>0ThenIf横の距離 >0Then方位判定 = West
        Else方位判定 = East
        EndIfElseIf縦の距離 >0Then方位判定 = North
        Else方位判定 = South
        EndIfEndIfEndFunctionSubシェイプ変更(TargetShape As Shape, T As MsoAutoShapeType)Dim接続されたコネクタ一覧 AsNew Collection
    Dim s As Shape
    
   '現在TargetShapeに接続されたコネクタを一覧化しておくForEach s In TargetShape.Parent.Shapes
        If s.Connector ThenIf s.ConnectorFormat.BeginConnected ThenIf s.ConnectorFormat.BeginConnectedShape Is TargetShape Then接続されたコネクタ一覧.Add _Array(s, s.ConnectorFormat.BeginConnectionSite,True)'True=BeginEndIfEndIfIf s.ConnectorFormat.EndConnected ThenIf s.ConnectorFormat.EndConnectedShape Is TargetShape Then接続されたコネクタ一覧.Add _Array(s, s.ConnectorFormat.EndConnectionSite,False)'False=EndEndIfEndIfEndIfNext'シェイプタイプを切り替えたタイミングでコネクタの接続が外れる
    TargetShape.AutoShapeType = T
    
   '一覧に登録されたコネクタをTargetShapeに再接続するDim c AsVariantForEach c In接続されたコネクタ一覧
        Dimコネクタ As Shape: Setコネクタ = c(0)If c(2)Then'True=Begin, False=Endコネクタ.ConnectorFormat.BeginConnect TargetShape, c(1)Elseコネクタ.ConnectorFormat.EndConnect TargetShape, c(1)EndIfNextEndSubSubチャート完成()Dim s As Shape
    Dim Arr()AsStringReDim Arr(0)ForEach s In Sheet1.Shapes
        If s.Type<> msoFormControl Then
            s.OnAction =""If s.Connector ThenIf s.Height <2Or s.Width<2Then
                    s.ConnectorFormat.Type= msoConnectorStraight
                EndIfEndIfIf s.Fill.Transparency =1And s.AutoShapeType = msoShapeFlowchartProcess Then
                s.DeleteEndIfEndIfNextCall Sheet1.ボタン状態クリア
EndSub

次に、Sheet1モジュールに以下のコードを張り付ける。

Private cm As Mode

PublicPropertyGet現在のモード()As Mode
    現在のモード = cm
EndPropertyPublicPropertyLet現在のモード(m As Mode)
    cm = m
EndPropertySubボタン状態クリア()With Sheet1.Buttons(Array("Mode3","Mode4","Mode5","Mode2")).Font
        .FontStyle ="標準".ColorIndex =0EndWithEndSubSub ModeButton()Set Module1.前にクリックしたシェイプ =NothingDim押されたボタン As Button
    Set押されたボタン = Sheet1.Buttons(Application.Caller)Callボタン状態クリア
    
    If現在のモード =CInt(Right(押されたボタン.Name,1))Then現在のモード = Mode.デフォルト
    ElseWith押されたボタン.Font
            .FontStyle ="太字".ColorIndex =5EndWith現在のモード =CInt(Right(押されたボタン.Name,1))EndIfEndSub

次にSheet1にボタンを配置する。

このボタンはフォームコントロールのものを使用すること。

割り当てるマクロは、次のとおり。
「ひな形作成」ボタン→「ひな型作成」マクロ
「プロセス入力」ボタン→「Sheet1.ModeButton」マクロ
「判断入力」ボタン→「Sheet1.ModeButton」マクロ
「コネクター」ボタン→「Sheet1.ModeButton」マクロ
「消去」ボタン→「Sheet1.ModeButton」マクロ
「チャートの完成」ボタン→「チャート完成」マクロ

ボタンを右クリックで選択すると、左上の名前ボックスで名前を付けることができる。

今回は押されたボタンの判定にこの名前を使用するので、
以下のボタンにはそれぞれ名前をつけておく。
「プロセス入力」ボタン→Mode3
「判断入力」ボタン→Mode4
「コネクター」ボタン→Mode5
「消去」ボタン→Mode2

以上でマクロは完成である。

使ってみる

ひな形作成ボタンを押すと、このように薄い枠が表示される。

私の環境では、シートのズームは70%くらいにしておくと収まりが良い。
（設計したときにシートが70%ズームになっているのに気づかず、その状態でフィットするようにコーディングしてしまった。将来的にはサイズ調整するUIも付けたいけど、今のところ作りっぱなしの手抜き）

プロセス入力ボタンを押すとボタンが青字になり、この状態で枠をクリックすることでプロセスが入力できる。

判断入力では「ひし形」の図形が配置される。

コネクターボタンをクリックすると、最初のプロセスクリックでは何も起きないが、その時にクリックしたシェイプを記憶し、次にクリックしたシェイプと矢印で接続される。連続でプロセスをクリックすることで次々つなげることができる。
一旦コネクターを切って新しいシェイプから始めたいときは、一度別のモードに切り替えるか、もう一度コネクターボタンを押して一度デフォルトモードにもどしてから、再度コネクターボタンでコネクタ接続モードに切り替える。

プロセスを修正するときは、プロセスモードで既存のプロセスをクリックすればよい。
プロセスを判断に切り替えたいときも、判断モードで既存プロセスをクリックする。
また、不要なプロセスを削除したい場合はシェイプごと消すのではなく、消去モードにしてクリックする。
コネクターの削除は今のところ手動だ。

最後にチャートの完成ボタンを押すと、不要な枠が消える。

また、作成途中はコネクターの種類がすべて鉤型コネクターなので、真横や真下につないでもズレて見える。

チャートの完成ボタンを押すことでこれらの本来まっすぐになるべきコネクタは直線コネクタに自動変換され、綺麗になる。

完成ボタンを押した後はプロセス入力はできなくなるので注意。

なお、再度ひな形作成ボタンを押すと、ボタン以外の全シェイプが消去されて新しい枠が配置される。

課題

斜めに配置されたプロセスを接続した場合はこのようになる。

これは、シェイプ同士の中心距離を縦、横ではかり、より短い方のルートを通るように設計したためだ。

ただ、フローの流れを考えると、この設計は失敗だった。

今のところ、このように混線してしまうので、これは手で付け替える必要がある。

デザイン

冒頭のアニメーションで紹介したマクロはセル幅をフローが収まる幅に合わせてある。
また、背景色やヘッダや罫線もあらかじめ作成してある。

フローの位置に合わせて手動でセル幅を変更する際は、ひな形の枠を全選択して書式設定からセルと連動して動かないように設定しておくとよい。

完成したフローを別のシートへ移動

完成したフローがこちら。

完成したフローを別のシートに移すには、オブジェクトの選択モードにして、

全シェイプ選択し、

この状態でコピーして別のシートに張り付ければ良い。

背景をデザインしている場合はこのように背景のセルを必要範囲選択してコピーすると、その範囲に存在するシェイプも一緒に付いてくる。

ただ、普通に張り付けるとセル幅に合わせてつぶれてしまう。

この場合は張り付け直後に表示される「Ctrl」と書かれた小さなポップアップをクリックし、元の列幅を保持するように変更すると直る。

マクロの解説

さて、マクロの動作についてざっくり簡単に概要を説明する。
まずひな形作成であるが、これは単に設定値に合わせてシェイプをAddしているだけ。
ポイントは「sh.OnAction = "Click"」でシェイプにマクロを登録している点である。
これは最終的にはチャート完成時に、「s.OnAction = ""」でマクロ登録を外している。

Clickマクロはシェイプで共通であるが、「Application.Caller」で呼び出し元のシェイプ名がわかるので、そのシェイプ名をもとに該当するシェイプオブジェクトを「今クリックしたシェイプ」変数に格納して操作している。

Clickマクロは現在のモードによって処理が分かれている。
モードはModule1の冒頭で列挙型「Mode」として定義しており、現在のモードはSheet1にプロパティとして保持させている。

モードは4つのモードボタンで切り替える。
これも共通のModeButtonマクロが呼び出されるが、呼び出したボタンはApplication.Callerで判定している。
「Dim 押されたボタン As Button」の部分で、Button型というのは見たことが無いかもしれない。
これはオブジェクトブラウザで非表示のメンバーを表示させると見ることができる。

ボタンもシェイプの一種ではあるが、Shape型で処理すると、「押されたボタン.Font」でメンバーが見つからないというエラーになる。
Object型で対応しても良かったのだが、インテリセンスを使わないと扱い方がわからなかったので固有型で宣言した。

プロセスや判断の入力、消去などはシェイプの変更で対応している。

コネクタの接続部分は苦労したが、今クリックしたシェイプと前にクリックしたシェイプの位置関係を「方位判定」関数で処理して適切な位置でつないでいる。
この関数の戻り値はModule1で定義している列挙型「Direction」である。

東西南北あるいは英語でNEWSを考えると、並び順が以下のようになっているのは不自然に思われるかもしれない。

PublicEnum Direction
    North =1
    West =2
    South =3
    East =4EndEnum

これはシェイプのConnectionSiteが次の順になっているので合わせた結果である。

最後にシェイプの完成時には高さまたは幅が2未満のコネクタを直線コネクタに変換している。
（1未満ではうまくいかなかったので2未満とした)

マクロの解説は以上

おわりに

私はこのマクロを「BreadChart(ブレッドチャート)」と名付けた。
最近たまたま電子工作で利用するBreadboardを見て閃いたためだ。
ブレッドボード - Wikipedia

サンハヤト SAD-101 ニューブレッドボード

• 出版社/メーカー:サンハヤト
• メディア: Tools & Hardware
• この商品を含むブログを見る

もともと5年ほど前からフローチャートを楽に作るマクロを考えていたのだが、当時は今一つ「これだっ」と思えるアイデアが出ずに悩んでいた。
また実装スキルも低かったので、「こんな風にやればできるかも」と思ってもなかなか作れなかった。
いろいろと試行錯誤しながらガラクタを作り続けているうちに徐々に実装スキルが付き、今では自分が「できるかも」と思ったものは大体作れるようになった。

今はできないことでも、トライ＆エラーを繰り返して悩むというプロセスを踏んでおけばスキルがついていつかできるようになる。そういうもんだと実感した。
みなさんも作りたいけどなかなかうまくいかないマクロがあったら、すぐに諦めずにあーだこーだ試行錯誤を続けると良い。たとえ今はガラクタであっても、いつかそれが宝の山になる日が来るかもしれない。