VBA Rangeオブジェクトはシートを操作するエージェント

VBAで扱える代表的なExcelのオブジェクトにWorkbook、Worksheet、Rangeなどがある。

• ひとつのブックにはひとつのWorkbookオブジェクトが対応している。
• ひとつのシートにはひとつのWorksheetオブジェクトが対応している。

ではひとつのセルに対応する固有のオブジェクトは？

5秒、4、3、2、1、はい。

Cellと答えたあなた。ぶっぶー。

Rangeと答えたあなた。ぶっぶっぶー。

実はひとつのセルに対応する固有のオブジェクトは存在しないってのが答え。

「固有の」ってとこがミソ。

まずCellというオブジェクトは存在せず、WorksheetオブジェクトのCellsプロパティが返すのは全セルを表すRangeオブジェクトである。このことは以下の記事で詳しく書いた。
thom.hateblo.jp

そもそもセルがいくつあるか考えてみよう。Excel2007以降、扱えるセル範囲は16,384桁1,048,576行となっている。つまり単純に掛け算して約170億個のセルが存在することになる。これらにそれぞれ対応するオブジェクトが存在するとしたらExcelだけでPCのメモリを食いつぶしてしまう。

じゃあいったいRangeとは何なのか。

Rangeとはシートを操作するエージェント(代理人)のようなものである。

ひとつ実験をしてみよう。
オブジェクトが一致するかどうかを比較する方法として、Is演算がある。
もしSheets(1).Range("A1")がひとつの固有なRangeオブジェクトを返すなら、以下はTrueになるはずだ。

Sub hoge()
    MsgBox Sheets(1).Range("A1") Is Sheets(1).Range("A1")
End Sub

実際に実行してみるとわかるが、上記のマクロはFalseになる。
同じセルを指してるのになんで！？と思うかもしれないけれど、これがエージェントと表現した所以。

つまりRangeとはWorksheetに代わってセルを操作する代理人(エージェント)である。

こんな風に、同じA1セルを管理していても、同じエージェントであるとは限らない。

だからこうやってIsで比較すると。

違うんだ！と。

つまりWorksheetオブジェクトのRangeプロパティは評価するたびに新しいRangeオブジェクトを生成しているのだ。

ちなみに変数に入れてあげれば当然一致する。

Sub hoge()
    Dim r As Range
    Set r = Sheets(1).Range("A1")
    MsgBox r Is r
End Sub

これはTrue。

ここで面白いのが、以下のようにOffsetをかますと不一致になるという点。

Sub hoge()
    Dim r As Range
    Set r = Sheets(1).Range("A1")
    MsgBox r Is r.Offset(0, 0)
End Sub

Offset(0, 0)ということは実質的におなじセルを指してるのに不一致。
つまりOffsetは内部で新しいRangeエージェントを作って返してるようだ。

以前クラスモジュール内で自身と同じ型の別インスタンスを返すという処理をやったけど、まさにあれと同じ。
thom.hateblo.jp

Offsetプロパティは内部でRangeをNewして返してるイメージ。実際に中身見たわけではないので具体的な実装は知らないけど。

なお、同じセルを指しているかどうかを調べたかったらAddressプロパティをイコールで比較してあげればよい。

Sub hoge()
    Dim r As Range
    Set r = Sheets(1).Range("A1")
    MsgBox r.Address = r.Offset(0, 0).Address
End Sub

これはTrueになる。

ちなみにシートの場合はどうかというと、

Sub hoge()
    MsgBox Sheets(1) Is Sheets(1)
End Sub

このように普通にIsで比較してもTrueが返される。

以下のように表現を変えてみても同じくTrue。

Sub hoge()
    MsgBox Sheets(1) Is Sheets("Sheet1")
End Sub

以下のように一旦別シート指してから戻しても同じようにTrueを返す。

Sub hoge()
    Dim sh As Worksheet
    MsgBox Sheets(1) Is Sheets(1).Next.Previous
End Sub

つまりこれが固有オブジェクトであるということ。

ひとつのセルに対応する固有のオブジェクトが存在しないという意味が伝わっただろうか。

オブジェクト指向における「メッセージ」とは何か

現在主に認知されているオブジェクト指向

私がオブジェクト指向というとき、それは基本的にC++から始まりJavaに受け継がれた、あのオブジェクト指向を指す。つまり、カプセル化、継承、多態性で説明されるアレだ。

VBAは継承、多態性のサポートがほとんど無いけれど、その中心となる考え方はC++のオブジェクト指向から受け継いだものだと思われる。

結論から言ってしまうと、このようなC++系統のオブジェクト指向において、メッセージという言葉は単にプロシージャ呼び出し※のことだ。
※VBA用語です。C++なら関数呼び出し。

つまりオブジェクト同士がメッセージをやりとりするというのは単に比喩表現であって、実態としてはプロシージャ呼び出しとその戻り値の受け取りに過ぎないってこと。

冒頭で述べたオブジェクト指向言語においてメッセージという比喩は混乱の元になるので使わないほうが良いと思う。UMLを学習するとシーケンス図で出てきてしまうけど。。

もうひとつのオブジェクト指向

さて、冒頭で「あのオブジェクト」と言ったのは、そうじゃないオブジェクト指向があるから。その代表はSmalltalk(スモールトーク)である。

最近以下の書籍でSmalltalkを少し齧っている。

SMALLTALKで学ぶ オブジェクト指向プログラミングの本質

しかし、はっきり言って、まえがきからして何を書いているのがサッパリわからない。。理解できないのは説明が悪いというより、そもそもこのSmalltalkという言語の特殊性が原因かもしれない。読めそうなところからぼちぼちトライしているところ。

さて、Smalltalkという言語はまさにオブジェクト同士のメッセージのやりとりというアイデアを比喩ではなくそのまま文法に取り入れた言語である。

たとえば 1 + 2 という計算式は、一般的に演算子「+」が「1」 と「2」 を取って計算すると認識されているが、Smalltalkでは違う。
「1」というオブジェクトに「+ 2」というメッセージを送信すると考えるのである。

またSmalltalkにはIfやforなどの制御構造が構文ではなくメッセージになっている。
真偽値オブジェクトに対し、IfTrue、IfFalseなどのメッセージを送るイメージ。

ってもまだうまくイメージできないのだけど。

たとえば以下のVBAコードは、

If 1 + 2 = 3 Then Debug.Print "Hello, world"

Smalltalkではこうなる。

(1 + 2 == 3) ifTrue: [Transcript show: 'Hello, world.']

1 + 2 == 3が評価されるとVBAでいうところのBoolean型になり、この真偽オブジェクトにifTrueメッセージを送る。その引数(?)に手続きを渡している。。という解釈であってるのだろうか。

このように、Smalltalkはすべてがオブジェクトとメッセージで成り立つ言語。そしてこちらのオブジェクト指向における「メッセージ」がまさに本来の「メッセージ」なのだ。

何いってるかわかんないだろう？実は私もだ。HA HA HA
ずっとC++系統のオブジェクト指向を学んできた私にとってSmalltalkは、まるで宇宙人だ。言葉どころか、身振り手振りすら通じない。

さっぱり分からない。実に面白い。

ガリレオ [DVD]

オブジェクト指向は一つではない

つまりオブジェクト指向言語には大きく分けてSmalltalkから始まった「オブジェクトとメッセージ」を中心に据えたものと、C++から始まった「カプセル化、継承、多態性」を中心に据えたものの2種類に分かれ、これらは全くといっていいほど異なっている。

もともとその源流となったのはSimulaという言語だった。Simulaはプログラミングにクラスやオブジェクトの概念を導入した初めての言語だ。しかしこのときにはまだオブジェクト指向という言葉自体は無かったそうだ。

Smalltalkを設計したアラン・ケイさんと、C++を設計したビャーネ・ストロヴストルップさんはどちらもSimulaという言語を見て「これは画期的なアイデアだ！」と思ったに違いない。しかしその着眼点は全く別のものだった。

こうして世の中に2つのオブジェクト指向が生まれ、「オブジェクト指向とは」という説明における大きな混乱の元になっている。メッセージという言葉はその典型で、これは明らかにSmalltalk系統のオブジェクト指向の考え方だ。すべてをオブジェクトとして扱うというのもSmalltalkの話であってC++系統のオブジェクトではそうではない。

これとは別の評価軸として、クラスベースかプロトタイプベースかという分類もあるので、オブジェクト指向が2種類であると言い切るにはちょっと複雑すぎるのだけど。

まとめ

• オブジェクト指向は一つではない。
• にも関わらず、「オブジェクト指向とは」という説明において、2つのオブジェクト指向がよく混同される。
• メッセージとは、C++系統のオブジェクト指向においては単にプロシージャ呼び出しの比喩、Smalltalk系統のオブジェクト指向においては言語機能そのもの。

個人的には、C++系統のオブジェクト指向の説明においてメッセージという用語はもう使わない方が良いんじゃないかと思う。私は長いこと、メソッドに渡される実引数のことと勘違いしていたが、それもメッセージという用語に「送信」というイメージがつきまとうためである。

C++系統のオブジェクト指向でプロシージャ呼び出しをメッセージ送信に見立てるのはちょっと無理があるんじゃないかな。

オブジェクト指向の本質はカプセル化 ～継承も多態性も脇役にすぎない

ずいぶんと挑発的なタイトルをつけてしまったが、継承や多態性が重要でないなどというつもりはない。
ただオブジェクト指向の本質はどれかと言われると、やっぱりカプセル化だろうなと。

オブジェクト指向とは

オブジェクト指向とは、データや機能をまとめて「モノ」として扱いましょうという方針を言う。

オブジェクトってのはモノのこと。フランス語の「オブジェ」のほうがイメージしやすいかも。

指向ってのは「はじめからその方向を指して向かうこと」という意味。つまり「方針」にしたがって進むこと。

オブジェクト指向の本質はカプセル化

カプセル化とは、データや、そのデータを操作する機能を、まるでカプセルに入れるみたいに、ひとつにまとめて扱うための仕組みのこと。つまりオブジェクト指向そのもの。

これがないと始まらない。

ここでオブジェクト指向を学習したことのある方はカプセル化とは隠ぺいのことだと思い込んでいる方もいると思う。隠ぺいというのはオブジェクトの中にあるデータや機能を好き勝手に使えないように制限をかけるっていう意味。中身を隠して見えなくしちゃうから隠ぺい。都合の悪い事実を隠蔽(いんぺい)するとか言うときのアレと同じ隠ぺいだけど悪い意味はない。

日本語版のWikipediaにだってカプセル化と隠ぺいを混同しているように思える。

じゃあ英語版はというと、General definitionという見出しで以下のように書かれている。(Google翻訳結果)

カプセル化とは、そのデータを操作するメソッドとデータのバンドルを指します。

メソッドといのうは機能、バンドルってのは「束(たば)」のこと。つまりデータと機能を束ねると書いてある。これが本質だ。

続いてカプセル化はデータ隠ぺいに使用されると書かれているが、重要なのはカプセル化した結果として隠ぺいすることも可能になるということであって、隠ぺいそのものをカプセル化と呼ぶわけではないこと。

隠ぺいもひじょーーーに有用な概念であるが、だからといってカプセル化の本質かというと違う。

データや機能をまとめて「モノ」として扱いましょうという方針に沿ってプログラミングするのに隠ぺいが必須かといえば、そんなことはない。内部のデータをバーンとPublicで公開しちゃってもモノはモノに違いない。

さて、さっきから色々書いてるけど、実際に言ってることはひとつ。
データや機能をまとめて「モノ」として扱いましょう。
つまりオブジェクト指向に必要な考え方は、これだけ。

ちなみにさっきからデータ「と」機能じゃなくて、データ「や」機能と言ってるのは、データだけまとめたり、機能だけまとめたりも出来るから。

オブジェクト指向の混乱を増長させる言葉

オブジェクト指向は複雑で分かりにくいという意見がある。
カプセル化・継承・ポリモーフィズム(多態性)・委譲・インターフェース・隠ぺい・デザインパターン・UML。オブジェクト指向の書籍を開くとこのようなちょっと意味不明な言葉がわんさか出てくる。

これらがごちゃっとなって「難しい・わからない」というイメージを一層強めているんじゃないかと思う。

オブジェクト指向の本質を理解するだけなら、最初からこんな訳のわからない(と思われている)大量の言葉を覚える必要ない。いつか必要になったときに覚えれば。

ただ一つ、「カプセル化」だけ覚えておこう。いますぐ。さぁ。

VBAだからわかるオブジェクト指向の本質

オブジェクト指向の三大要素と呼ばれている機能がある。
・カプセル化…データと機能をまとめること
・継承…別のオブジェクトから機能や特徴を受け継いで新しいオブジェクトを作ること
・多態性…同じ命令を出してもオブジェクトによって異なる振る舞いをさせること
の3つだ。

継承や多態性は確かに便利である。もはやそれ無しではオブジェクト指向言語とは言えないほどに。

ところがVBAはというと、継承と多態性をまともにサポートしていない。つまり言語の機能としては、三大要素のうちオブジェクト指向の本質である「カプセル化」しか存在しないのである。

だからこそオブジェクト指向の本質がカプセル化であるという説明を(どこかで)読んだときすぐにピンと来た。たぶんオブジェクト指向をJavaでだけやってたら私は今でも三大要素は等しく重要だと思いこんでいたことだろう。

カプセル化さえあれば、継承と多態性がなくてもオブジェクト指向のメリットを享受できるのだ。

継承も多態性も使わない、そして隠ぺいすらしない楽々オブジェクト指向

オブジェクト指向は複雑であると思われているけれど、それはオブジェクト指向のセオリーに完璧に従った場合の話。

私は最初からそんなややこしいことをする必要は無いと思っている。まずはデータと機能をモノとして扱えることの楽さを味わって「オブジェクト指向スゲー！」となるのが先決だ。いろんな機能はそのあとに学んでいけば良いと思う。

まずデータと機能をまとめるというのがどういうことなのか、具体的なやり方は以下の入門記事を参照してほしい。
thom.hateblo.jp

それから、上を読み終えた方はこの記事がおススメ。ゆるーくオブジェクトを使って楽をしている。
thom.hateblo.jp

VBA Application.OnKeyを使い、F1キーで任意のアクティブブックのメインプロシージャを実行させる

今回の記事はF1キーを押したときに、今使用しているブックによって実行するプロシージャを分けるというもの。

執筆のきっかけになったのはこちらの記事のコメント欄のやりとり。
chemiphys.hateblo.jp

OnKeyマクロを記載したブックを閉じた後，そのショートカットを実行すると，OnKeyマクロを記載していたブックを自動的に開いてそのマクロを実行しようとする

なるほど、特定ブックでのみ使用するマクロをOnKey登録し、解除を忘れる(あるいは失敗する)と上記のように想定外の事象になってしまうデメリットがある。

F1キーを特定ブックのマクロに紐づけてしまうと、Excelアプリ全体に作用してしまい、F1キーはそのブックのマクロ実行専用になってしまう。

では、発想を変えて特定ブックに紐づかない実行キーを作ってしまおうと考えたのが今回のネタ。

この記事ではその仕掛けはPersonal.XLSBに作成するが、配布を考慮するならアドイン化しておくのも良いと思う。

まずPersonal.XLSB(個人用マクロブック)のThisWorkbookシートモジュールに以下のコードを記述する。

Private Sub Workbook_Open()
    Application.OnKey "{F1}", "'MacroLauncher ""F1_Key""'"
End Sub

つまりこれで、Excelを起動した際にF1キーにMacroLouncherプロシージャ呼び出しが登録される。
文字列"F1_Key"はMacroLouncherの引数で、実際に呼び出すブックごとのマクロ名を指す。

※本当はF1というプロシージャにしたかったけど名前が不適切となるのでやめた。恐らくキーコード定数と被っているせいかと思う。

わざわざ引数にしたのは後からF3、F4なども簡単に追加できるようにするため。
※F2は個人的にExcel本来のショートカットとしてよく使うのでマクロで上書きするわけにはいかない。

次にPersonal.XLSBに標準モジュールを追加し、以下のコードを記述する。

Sub MacroLauncher(macro_name)
    Dim QuotedBookName As String
    QuotedBookName = "'" & ActiveWorkbook.Name & "'"
    
    On Error Resume Next
        Application.Run QuotedBookName & "!" & macro_name
    On Error GoTo 0
End Sub

こうするとF1キーを押した際にMacroLouncherを経由してApplication.RunでアクティブブックのF1_Keyプロシージャが呼び出されるようになる。On Errorで囲んでいるのでマクロ登録がないブックでは何も起きない。登録がない旨のメッセージを出すようにしても良いかもしれない。

これで準備は整った。
あとはショートカットを使いたいブックごとにF1_Keyプロシージャを作り、それをメインコードにするか、そこからメインコードを呼び出すようにすれば完成。

ただこのテクニックはきわめて個人的な改善なので、チームが共通で使うようなブックだと、なかなか使えない。
F1_Keyプロシージャを作らせてもらうか、それともしれっと作ってしまうか、オフィシャルにして皆にも使ってもらうかという方向になるかと。

あと発展系としてはシートごとにF1キーの意味を変えたい場合にも使えると思う。
Application.Runの引数文字列の書式は 'ブック名'!シートオブジェクト名.マクロ名 である。(試してないけど、たぶん。)

VBA ヒープソートを実装 ～関数を沢山作って複雑な問題に対処する

私は長らくヒープソートというものが理解できなかったのだが、ついに今日、なんとか動くところまで実装できたので紹介しようと思う。

ヒープソートを理解しようと思ったら、実装の前にまずヒープのノードが入れ替わるイメージを理解しておく必要がある。
そこで、こちらの動画を視聴した。

ヒープソート

めっちゃわかりやすい！

ん、理屈は分かったけど、これをいったいどうやって実装すれば。。

ということでもう一本動画を視聴。

［ソート4］ヒープソート（Heap Sort）：解説

最初のほう早くて分かりにくいけど、1分10秒あたりから配列を使った実装の詳細の説明に入るのでしっかり視ておく。

さて、ヒープを配列に導入すると、親と子を指すインデックスには次の式が成り立つ。
左の子のインデックス = 親のインデックス×2＋1
右の子のインデックス = 左の子のインデックス + 1

これがメインコードに登場するとごちゃっとするので、関数化してしまおう。

Function GetRightChildIndex(parent_index) As Long
    GetRightChildIndex = GetLeftChildIndex(parent_index) + 1
End Function

Function GetLeftChildIndex(parent_index) As Long
    GetLeftChildIndex = parent_index * 2 + 1
End Function

それから、親を左の子と入れ替える処理、親を右の子と入れ替える処理というのも解説に登場したので、これもプロシージャ化する。

Sub SwapParentRightChild(arr, parent_index)
    Dim tmp: tmp = arr(parent_index)
    arr(parent_index) = arr(GetRightChildIndex(parent_index))
    arr(GetRightChildIndex(parent_index)) = tmp
End Sub

Sub SwapParentLeftChild(arr, parent_index)
    Dim tmp: tmp = arr(parent_index)
    arr(parent_index) = arr(GetLeftChildIndex(parent_index))
    arr(GetLeftChildIndex(parent_index)) = tmp
End Sub

子より親の方が小さければ、入れ替えるという処理をするが、このとき、両方の子が親より大きい場合、より大きい方を選択するという処理があった。
これ、言い換えると、親・左の子・右の子のうち、一番大きいものと親を入れ替えるということになる。親が一番なら入れ替えは発生しないが、とにかく誰が一番大きいかを判定する関数があると良い。

この関数は、列挙型定数でParent、LeftChild、RightChildのいずれかを返すようにしよう。

ということでまずは列挙型を作成。

Enum Role
    Parent
    LeftChild
    RightChild
End Enum

次にこれを返す関数を作成。

Function WhoIsBiggest(arr, parent_index, tail) As Role
    Const INIFINITESIMAL As Long = -2147483648#
    Dim p: p = arr(parent_index)
    Dim rc
    If GetRightChildIndex(parent_index) <= tail Then
        rc = arr(GetRightChildIndex(parent_index))
    Else
        rc = INIFINITESIMAL
    End If
    
    Dim lc
    If GetRightChildIndex(parent_index) <= tail Then
        lc = arr(GetLeftChildIndex(parent_index))
    Else
        lc = INIFINITESIMAL
    End If
    
    If p > lc And p > rc Then
        WhoIsBiggest = Parent
    ElseIf lc > p And lc > rc Then
        WhoIsBiggest = LeftChild
    ElseIf rc > p And rc > lc Then
        WhoIsBiggest = RightChild
    End If
End Function

INIFINITESIMALという定数の名前は英語の「無限小」をとったもの。
実際にはただのLong型の最小値である。
子のインデックスがtailを超えてしまう場合、参照エラーになったり確定値を参照してしまう危険がある。
そこでtailを超えた子より、必ず親が大きくなるように、子の値を入れる変数に無限小を代入している。
ここは力技でしのいだ感じ。

さて、あとは確定した最大値を取り除く処理だ。
これは配列の先頭と末尾を入れ替えてしまえば良いので、そのような関数を作る。
ただし毎回末尾と入れ替えてたら確定値まで動かしてしまうことになる。
したがって末尾はUboundではなく、別途変数で管理しよう。

ひとまずはtailという仮引数で末尾を受け取ることにする。
先頭は0で固定なので受け取る必要はない。

Sub SwapHeadTail(arr, tail)
    Dim tmp: tmp = arr(0)
    arr(0) = arr(tail)
    arr(tail) = tmp
End Sub

さて、役者は揃った。
あとはメインコードをガリガリ書くだけ。

Sub HeapSortMain()
    Dim heap(): heap = Array(8, 2, 7, 6, 9, 1, 4, 3, 5)
    Dim tail As Long: tail = UBound(heap)
    Do
        Do
            Dim cnt: cnt = 0
            Dim i
            For i = LBound(heap) To tail
                Select Case WhoIsBiggest(heap, i, tail)
                Case Role.Parent
                    cnt = cnt + 1
                Case Role.LeftChild
                    SwapParentLeftChild heap, i
                Case Role.RightChild
                    SwapParentRightChild heap, i
                End Select
            Next
        Loop While cnt <= tail
        SwapHeadTail heap, tail
        tail = tail - 1
    Loop While tail > 0
    
    For i = LBound(heap) To UBound(heap)
        Debug.Print heap(i)
    Next
End Sub

まずは最も内側のループからみていこう。

For i = LBound(heap) To tail
    Select Case WhoIsBiggest(heap, i, tail)
    Case Role.Parent
        cnt = cnt + 1
    Case Role.LeftChild
        SwapParentLeftChild heap, i
    Case Role.RightChild
        SwapParentRightChild heap, i
    End Select
Next

このループは配列を先頭から末尾(tail)まで流している。
ループの中では誰が一番大きいかを判定するWhoIsBiggestによりSwap処理を行っている。Swapが発生しなければcntが増える仕組みだ。

その外側のDoループでは、cntとtailが一致するまで繰り返しを行っている。cnt=tailということは、一度もSwapされなかったということ。つまり正しいヒープ構造になっているので、これ以上内側のForループを回す必要がなく、一巡目の最大値が確定したということ。

それからSwapHeadTailで最大値と末尾(tail)を入れ替え、tailを一つ減らしている。
これを繰り返すことで最大値がどんどん配列の底にたまっていく。

tailが0になったらループを抜けると、配列は見事昇順に並んでいるというわけだ。

私にとってややこしいのは、ヒープというツリー型の構造を無理やり配列で扱うこと。
そしてそれぞれの計算がメインコードに出てくることで頭が追い付かなくなる。

今回は関数に分割したことで、個人的にはわかりやすくできた。

これを見たみなさんがどう感じるかはまた別の話であるが。。

VBA Collectionを使って数値をランダムに並び替える

今回はn個の数値をランダムに並び替えるアルゴリズム。
元ネタはこちらの記事。
chemiphys.hateblo.jp

上記はRnd関数のランダム性を利用したアルゴリズムで、出てきたSingle値の順位を付けることで結果的にその順位が重複のないランダムな数列になるというもの。

たとえば1～5をランダムに並び替えたいとする。

このようにRndを5回評価し、大きい順に順位をつける。

回数	Rnd結果	順位
1回目	0.4013743	2位
2回目	0.27828	3位
3回目	0.1604415	5位
4回目	0.1628216	4位
5回目	0.6465871	1位

この順位がそのまま2, 3, 5, 4, 1という数列になるわけだ。
なるほど、面白い。

では私はということで、あらかじめ用意した数値をランダムにシャッフルするというアルゴリズムでやってみよう。

出来たのがコレ。

Sub ShuffleCollection(c As Collection)
    Dim cc As Collection: Set cc = New Collection
    Dim m As Long
    Do While c.Count > 0
        m = Int(c.Count * Rnd + 1)
        cc.Add c.Item(m)
        c.Remove m
    Loop
    Set c = cc
End Sub

上記に、なんでもいいのでコレクションを渡すと、順番がバラバラになる。
実際にこれを使うコードを作ってみた。

Sub Main()
    Dim c As Collection: Set c = New Collection
    c.Add 1: c.Add 2: c.Add 3: c.Add 4: c.Add 5
    ShuffleCollection c
    Dim x
    For Each x In c
        Debug.Print x
    Next
End Sub

何度か実行してみると、確かにシャッフルされてるのがわかる。

仕組みとしては、最初はコレクションcに5つの要素が入ってるので、1～5の範囲でランダム値を生成してそれを別のコレクションccに入れる。コレクションcからは、削除する。するとcの要素は4つになるので、1～4の範囲でランダム値を生成して～と繰り返す。
cの要素が0になったら、ccにすべて移ってるので、Set c = cc としておしまい。

関数として非破壊的に作っても良いかな。

こんな感じか。

Function CreateShuffledCollection(c As Collection) As Collection
    Dim cc As Collection: Set cc = New Collection
    Dim i
    For i = 1 To c.Count
        cc.Add c.Item(i)
    Next
    
    Dim ccc As Collection: Set ccc = New Collection
    Dim m As Long
    Do While cc.Count > 0
        m = Int(cc.Count * Rnd + 1)
        ccc.Add cc.Item(m)
        cc.Remove m
    Loop
    Set CreateShuffledCollection = ccc
End Function

これなら元のコレクションは破壊されない。
ついでに1～5をAddするのも関数化してしまおう。

Function GetSequence(n As Long) As Collection
    Dim ret As Collection: Set ret = New Collection
    For i = 1 To n
        ret.Add i
    Next
    Set GetSequence = ret
End Function

元記事は配列だったな。。ということで配列変換も関数化する

Function ChangeCollectionToArray(c As Collection) As Variant
    Dim ret(): ReDim ret(0 To c.Count - 1)
    For i = LBound(ret) To UBound(ret)
        ret(i) = c.Item(i + 1)
    Next
    ChangeCollectionToArray = ret
End Function

これをメインコードにまとめると、こうなる。

Sub Main2()
    Dim arr: arr _
        = ChangeCollectionToArray( _
            CreateShuffledCollection( _
                GetSequence(5)))
    Dim x
    For Each x In arr
        Debug.Print x
    Next
End Sub

以上

VBA マクロの高速化のためのApplication設定をクラスモジュールにまとめる

今回はちょっと変わったクラスモジュールのテクニック案。
異端扱いされそうな気がするので、思いついた私自身、採用には慎重なのだけれど、アイデアとしては面白いと思ったので備忘録として公開してしまうことにした。

さて、過去にPropertyプロシージャを使った高速化テクニックというのをやった。
thom.hateblo.jp

今回も基本的にはApplication設定を変更するだけなのだが、クラスモジュールを使って更に怠慢にやろうという話。

作り方

クラスモジュールを挿入し、オブジェクト名を「OneTimeSpeedBooster」に変更する。
このクラスの名前付けは超重要！！
そもそも馴染みのない異端テクニックなので、何がしたいのか名前で示さないと訳が分からなくなる。

クラスに書くコードはこちら。

Private Sub Class_Initialize()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .PrintCommunication = False
    End With
End Sub

Private Sub Class_Terminate()
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .PrintCommunication = True
    End With
End Sub

見ての通り、コンストラクタとデストラクタしかない。
コンストラクタで高速化設定を行い、デストラクタで標準設定にもどしている。

使い方

OneTimeSpeedBoosterを使う前に、まずは時間のかかるマクロを作ってみる。
計算が必要かつ、画面更新が発生するものが良い。

九九を100×100まで計算させつつ、セルの色をランダムで塗りつぶすようにしてみよう。

コードはこのとおり。

Sub hoge()
    Dim t As Double: t = Timer
    For i = 1 To 100
        For j = 1 To 100
            With Sheet1.Cells(i, j)
                .Value = "=" & i & "*" & j
                .Interior.Color = RandomColor
            End With
        Next
    Next
    Debug.Print Timer - t
End Sub

Function RandomColor()
    RandomColor = RGB( _
        Int(256 * Rnd), _
        Int(256 * Rnd), _
        Int(256 * Rnd))
End Function

完成！

タイムは、3.7秒。はやっ！

では、ズームで10%まで小さくして、画面に入る描画範囲を増やしてみよう。

タイムは、9秒。

ではこれがどれだけ早くなるか。
コードは次のとおり。

Sub hoge()
    Dim t As Double: t = Timer
    Dim booster: Set booster = New OneTimeSpeedBooster
    For i = 1 To 100
        For j = 1 To 100
            With Sheet1.Cells(i, j)
                .Value = "=" & i & "*" & j
                .Interior.Color = RandomColor
            End With
        Next
    Next
    Debug.Print Timer - t
End Sub

Function RandomColor()
    RandomColor = RGB( _
        Int(256 * Rnd), _
        Int(256 * Rnd), _
        Int(256 * Rnd))
End Function

タイムは、1.16秒！

9秒から1秒なので実に90%も高速化したことに、、、、なる、、のか。。
っ！計算に自信がない！！

で、肝心のコードだけれど、足したのは以下の1行のみ。
Dim booster: Set booster = New OneTimeSpeedBooster

名前付けが超重要と書いたのは、上手い名前を付けていても変数宣言してセットしたはいいけど何も使われていないアホなコードに見えるのに、まして下手な名前なんてつけたら。。ということ。

OneTimeSpeedBoosterのインスタンスが作られるとコンストラクタによって各種アプリケーション設定が変更され、プロシージャの終了とともにこのbooster変数は破棄されるので、デストラクタによってアプリケーション設定がもとに戻る仕組み。

あるいは、Withを使ってこの区間ブーストするみたいな表記もアリか。

Sub hoge()
    Dim t As Double: t = Timer
    With New OneTimeSpeedBooster
        For i = 1 To 100
            For j = 1 To 100
                With Sheet1.Cells(i, j)
                    .Value = "=" & i & "*" & j
                    .Interior.Color = RandomColor
                End With
            Next
        Next
    End With
    Debug.Print Timer - t
End Sub

ま、今回は思考実験みたいなものなので、あまり真に受けないでほしい。
特にマジに批判するとかはナシで！！

良いと思った方は自己責任でどうぞ！