VBA オートシェイプを使った泡のアニメーション

TwitterでJavascriptを使った綺麗なアニメーションが流れてきたので、VBAでも真似してみた。
ics.media

本家の躍動感まではコピーできなかったけど、それなりに見栄えのするアニメーションができたので紹介。

作り方

まずSheet1のオブジェクト名をプロパティウィンドウからScreenに変更する。

そしてシートモジュールScreenのコードに初期化用のClearプロシージャを用意しておく。

Sub Clear()
    Me.Cells.Interior.Color = vbBlack
    Dim sh As Shape
    For Each sh In Me.Shapes
        sh.Delete
    Next
End Sub

次にクラスモジュールを挿入し、オブジェクト名をBubbleとする。

クラスのコードはこちら。

Option Explicit
Private bubbleShape As Shape
Private speed As Double
Private scales As Double

Public Function Float() As Boolean
    If bubbleShape.Top - speed > 0 Then
        bubbleShape.IncrementTop -speed
        speed = speed * 1.1
        scales = scales * 0.99
        bubbleShape.ScaleHeight scales, msoFalse, msoScaleFromMiddle
        bubbleShape.ScaleWidth scales, msoFalse, msoScaleFromMiddle
        Dim c: c = Int((255 - 100 + 1) * Rnd + 100)
        bubbleShape.Fill.ForeColor.RGB = RGB(c, c, c)
        Float = True
    Else
        Float = False
    End If
End Function

Private Sub Class_Initialize()
    Randomize
    speed = 5
    scales = 1
    
    Dim x: x = Int((Application.Width - 0 + 1) * Rnd + 0)
    Dim y: y = Int((Application.Height - 200 + 1) * Rnd + 200)
    Dim size: size = Int((50 - 30 + 1) * Rnd + 30)
    If Int((1 - 0 + 1) * Rnd + 0) = 1 Then
        Set bubbleShape = Screen.Shapes.AddShape(msoShapeDonut, x, y, size, size)
        bubbleShape.Adjustments.Item(1) = 0.1
    Else
        Set bubbleShape = Screen.Shapes.AddShape(msoShapeOval, x, y, size, size)
    End If
    bubbleShape.Line.Visible = msoFalse
    bubbleShape.Fill.ForeColor.RGB = vbWhite
    bubbleShape.Fill.Transparency = 0.1
End Sub

Public Property Get Self() As Object
    Set Self = Me
End Property

Private Sub Class_Terminate()
    bubbleShape.Delete
End Sub

最後にメインプロシージャ用に標準モジュールを挿入する。
このモジュールのオブジェクト名は任意。

標準モジュールに書くコードはこちら。

Option Explicit
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If
Sub BubbleAnimation()
    Const BUBBLE_LEVEL = 5 ' 1 to 10
    Screen.Clear
    Dim bubbles As Collection: Set bubbles = New Collection
    Do
        Application.ScreenUpdating = False
        Dim i
        For i = 1 To Int((BUBBLE_LEVEL - 0 + 1) * Rnd + 0)
            bubbles.Add New Bubble
        Next
        
        Dim j
        For j = bubbles.Count To 1 Step -1
            If Not bubbles(j).Float Then
                bubbles.Remove j
            End If
        Next
        Application.ScreenUpdating = True
        Sleep 10
        DoEvents
    Loop
End Sub

あとはBubbleAnimationを実行すればアニメーションが始まる。
終了方法は用意してないのでVBEの停止ボタンで止めている。

※今回のコードはお遊びなので割とやっつけコーディング。
　そのためマジックナンバーを多用してるが、良い子は真似しないように。

VBA 業務フローチャートをマクロで簡単に作成するツールの更新と公開

以前、フローチャートを作成するツールの作り方を紹介した。
thom.hateblo.jp

こちらの反響が良かったのと、ちょうどお盆休みをいただいてて良い機会なのでもうすこしブラッシュアップし、GitHubで公開してみた。

公開場所とダウンロード方法

以下のリンクにてxlsmファイルを公開中。
BreadChart/BreadChart.xlsm at master · thom-jp/BreadChart · GitHub

リンク先に飛んだら右下あたりのDownloadボタンでダウンロード可能。

ソースコードだけ閲覧したい場合は以下BreadChartのトップから src/BreadChart.xlsm を開き、各ファイルを閲覧できる。
github.com

使い方

基本的に使い方は以前のバージョンと同じなので以下のGIFアニメ参照。

以前のバージョンの課題と改善したポイント

以前はセルのマス目とプロセス(フローチャートのひとつひとつの四角)の位置が連動しておらず、プロセスが表示される場所に合わせてセルの幅をうまく調整する必要があった。

今回は1セルに1プロセスが収まり、セル幅、高さを変えてもひな形作成時にプロセスがセルの中央に配置されるようになった。

ひな形を作成する範囲は名前の管理で"BreadRange"を編集することで変更可能になった。

また、以前のバージョンではコネクタは最短距離で結ばれる仕様だったので、以下のように混線することがあった。

今回のバージョンでは横並び以外は原則上から下へ接続されるように変更した。

また、以前のバージョンではプロセス入力モードで既存のプロセスをクリックした際に内容を1から入れ直しだったが、今回は既存の入力内容をあらかじめテキストボックスに表示させる仕様にした。これで文言を微修正したいときに最初から入れ直す必要がなくなった。

以前のバージョンでは判断入力はあまり文字が入らなかった。
以下は、"判断入力はあまり文字が入らない"と入力した結果。

3文字しか表示されてない。ひどい。。

改良したものがこちら。

文字がはみ出しても枠線が邪魔にならないように枠線を廃止して、更に以下の設定を行っている。

これに合わせてプロセスの文字入力もセンター揃えになった。

あとは地味な改良であるが、ひな形作成ボタン押下時に編集内容が消えてしまう旨と、チャートの完成ボタン押下時に一旦完成させると編集モードに戻せない旨の警告表示を追加した。

以上

VBA For Eachが順番を保証しない理由を自作のコレクションで説明

今回はVBAのFor Eachステートメントが仕様上、出力順を保証しない理由についてC#で作った自作のコレクションを使って説明してみようと思う。

さて、普段ならコードから紹介して後で説明に入るスタイルを取るが、今回はちょっとややこしいのでいきなり本題の説明から入ろうと思う。

前提知識

Excel VBAは、VBA言語によってExcelオブジェクトを操作することをいう。初心者のうちはVBAの命令もExcelオブジェクトのメソッドも一緒くたに考えてしまうけれど、VBAはVBA、ExcelはExcelなので、この2つが頭の中できちんと分離できていることが前提となる。

説明

VBAのFor Eachはその仕様上、出力順を保証していない。

とはいっても、たとえば以下のような選択範囲に対し、

次のコードを実行してみると、

Sub hoge()
    For Each x In Selection
        Debug.Print x
    Next
End Sub

常に、1,2,3,4,5,6,7,8,9の順に出力される。

にも関わらず、For Eachが出力順を保証しないとはどういうことか。

For Each「が」保証していないというところがミソ。

VBAのFor Each文はオブジェクトに対して、「次のアイテムちょうだい」っていう命令を出す。
このとき、何を次のアイテムとして差し出すかはオブジェクトの実装によるということだ。
つまり順序よく綺麗に出力されるのはVBAがやってるんじゃなくて、ExcelのRangeオブジェクトがそういう風にアイテムを返しているからだ。
じゃあExcel側が保証してるかというと、それはそれで特にドキュメントが無いのでやはり将来その仕様が絶対に変更されないとは言えない。

さて、説明はここまで。
ここからはこの説明を裏付ける証拠として、登録したのとは逆順にFor Eachで出力されるコレクションを作ってみようと思う。

実演

※注意：今回は手探りの実験になったので、読者の皆さんの環境において動作を保証するものではありません。もし真似される場合はくれぐれも自己責任でお願いします。

Visual Studioの操作

今回はVisual Studio Community 2017を使用した。
起動するとスタートページが開くので新しいプロジェクトの作成をクリック。

Visual C#のクラスライブラリ(.NET Standard)を選択して、名前はそのままでOK。

ソースコード「Class1.cs」の編集画面になるので全部テキストを削除する。

以下のコードを張り付け。

using System;
using System.Collections;
using System.Collections.Generic;
using System.Runtime.InteropServices;

namespace ThomSample
{
    [ComVisible(true)]
    [Guid("A4496B44-8A89-4ABB-A6F0-91B81D56A1C9")]
    [InterfaceType(ComInterfaceType.InterfaceIsDual)]
    public interface IContraryCollection : IEnumerable
    {
        new IEnumerator GetEnumerator();
        void Add(string str);
    }

    [ComVisible(true)]
    [Guid("338178CD-EAFB-4AD6-B8AF-27AB8E50CB24")]
    [ProgId("ThomSample.ContraryCollection")]
    [ClassInterface(ClassInterfaceType.None)]
    public class ContraryCollection : IContraryCollection
    {
        public List<String> list;

        public ContraryCollection()
        {
            list = new List<string>();
        }

        public IEnumerator GetEnumerator()
        {
            for (int i = list.Count-1; i >= 0; i--)
            {
                yield return list[i];
            }
        }

        public void Add(string str)
        {
            list.Add(str);
        }
    }
}

ファイルメニューからすべて保存。

ビルドメニューからClassLibrary1のビルドを実行。

左下のステータスバーにビルド正常終了とでたらOK。

ソリューションエクスプローラーの余白で右クリックしてメニューからエクスプローラーで開くを選択。

\bin\Debug\netstandard2.0の順に開くとClassLibrary1.dllが入っているので、デスクトップ等の分かりやすい場所に配置する。

dllのレジストリ登録

作成したdllはCOMとして登録する必要があるが、これにはVisual Studioについてくるregasmというコマンドツールを使う。

このコマンドツールを使うには開発者コマンドプロンプトを使用する必要があり、さらに管理者モードで起動する必要がある。
まず、Windows10の場合は以下のパスに開発者コマンドプロンプトへのリンクがあるのでパスを開く。
C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Visual Studio 2017\Visual Studio Tools

右クリックして管理者として実行する。

cdコマンドでClassLibrary1.dllを置いた場所に移動する。

コマンドで regasm /codebase ClassLibrary1.dll を実行する。
うだうだ文句を言われるが、ちゃんと管理者で実行できてれば一応成功する。

これでレジストリ登録もOK。
ちなみにregasm /u ClassLibrary1.dll で登録解除できる。

VBAからの利用

ここからようやくVBA。
適当にブックを作成して標準モジュールに次のコードを張り付けて実行する。

Sub hoge()
    Set c = CreateObject("ThomSample.ContraryCollection")
    c.Add "a"
    c.Add "b"
    c.Add "c"
    c.Add "d"
    c.Add "e"
    For Each x In c
        Debug.Print x
    Next
End Sub

すると、For Each文で、登録したのとは逆順に、e, d, c, b, aと出力される。

ちょっとC#の知識がないとややこしいのでうまく説明できないけれど、逆順に返している部分はこちら。

        public IEnumerator GetEnumerator()
        {
            for (int i = list.Count-1; i >= 0; i--)
            {
                yield return list[i];
            }
        }

yield returnはEnumeratorによってアイテムが要求される度に値を返す性質があるようだ。
for文とyield returnによってリターン用に値がストックされてるイメージかな。
それでFor Eachが実行されると値が要求するたびに出力される。このとき逆順なのは、for文を回す際にiをマイナスしてるから。
私自身、あんましC#に詳しくないので上手く説明できないのが残念だけど雰囲気だけでも伝わればと思う。

検証が終わったらregasm /u ClassLibrary1.dll で登録解除も忘れずに。

まとめ

これで出力順をコントロールしてるのはFor Eachではないことが明白になった。
繰り返しになるが、For Eachで次に何のアイテムが出力されるかは、オブジェクト次第ということだ。

参考

C#でGetEnumeratorを実装したクラスをCOMとして公開する方法について参考にさせていいただいた記事。
Exposing an Enumerator from Managed Code to COM. - limbioliong
上記ではList型が持つEnumeratorを返している。

以下はC#でGetEnumeratorを自分で実装する方法
ledsun.hatenablog.com
既存型のEnumeratorではなくて自分で実装したかったのでこちらを参考にさせていただいた。

以下はGUID(UUID)の生成に使ったツール
GUID生成ツール

GUID(UUID)とは何ぞやというのは以下
e-words.jp

VBA セル上で文字列の置換を取り消し線と置換後の新しい色で表現する

元ネタはこちら。おもしろそうなのでやってみた。
infoment.hatenablog.com

今回やりたいことは、文字列の一部を置換したときにその履歴そのものを取り消し線と色で表現したいというネタ。

つまり図示するとこういうこと。

参照元の記事では1回目は上手く行ってるんだけど、2回目に失敗している様子。

つまり、以下を成功させたい。

まずはデータ構造を考えてみる

複雑なプログラムを組む際に一番意識すべきはデータ構造。
やりたいこととデータ構造が綺麗にリンクしていれば、もう勝ったも同然。

今回のケースだと、文字ごとにステータスを持たせるのが良さげ。
以下のように一文字ずつ、取り消し線が引かれているか否か、追加された文字(つまり青字)か否かと、今回挿入する文字の挿入位置かどうかをTrue / Falseで管理する。

図では、Tと入っているところがTrueで、何もないところはFalse。

これはあくまでイメージ図なので、ここから実際のプログラムで使えるデータ構造に落とし込んでいく。
この表形式に思考を引っ張られると、じゃあ二次元配列で考えるか？とか間違った方向に進むので注意。

現実のデータ構造は階層を成していることが多いので、一旦ツリー型に落とし込んでみる。

次にこのツリーをどうやって表現するか。
文字のデータはクラスで表現しても良いけど、一文字ずつインスタンス化するのはちょっと大げさなので今回はユーザー定義型を採用することにする。さらにステータス部分は別のユーザー定義型にしてネストさせることにした。(今思えば各ステータスをテキストと並列にしても良かったかも。)
ユーザー定義型はコレクションに追加できないのでテキストのデータ集合としては自ずと配列に決まる。

構造部分だけをVBAコードに落としこむと、次のようになる。

Type State
    Strikethrough As Boolean
    InsertPoint As Boolean
    Replaced As Boolean
End Type

Type StatefulChar
    Text As String
    State As State
End Type

Private CellText() As StatefulChar

CellTextは動的配列で宣言し、実際にセルのテキストを格納する段でサイズを確定させる。

出力方法について考える

データの管理の他に、もうひとつ厄介な問題がある。それは文字の出力だ。
セル内のテキストに書式を持たそうとするのは面倒な処理が必要になる。

そこで今回は以前に作ったセル内の文字を簡単に色付けするためのクラスを少し改造して、取り消し線に対応させることにした。
thom.hateblo.jp

コード

ここからはコードの全体を紹介する。

まずはクラスモジュールを挿入し、名前をColorfulStringObjectとする。
コードは以下のとおり。

Private Type ColorText
    TextPart As String
    ColorPart As XlRgbColor
    Strikethrough As Boolean
End Type
Private colorTextArray() As ColorText

Private Sub Class_Initialize()
    ReDim colorTextArray(0)
End Sub

Sub AddText(txt As String, Optional col As XlRgbColor = rgbBlack, Optional strike_through As Boolean = False)
    colorTextArray(UBound(colorTextArray)).ColorPart = col
    colorTextArray(UBound(colorTextArray)).TextPart = txt
    colorTextArray(UBound(colorTextArray)).Strikethrough = strike_through
    ReDim Preserve colorTextArray(UBound(colorTextArray) + 1)
End Sub

Function GetText()
    Dim ret As String
    Dim i As Long
    For i = 0 To UBound(colorTextArray) - 1
        ret = ret & colorTextArray(i).TextPart
    Next
    GetText = ret
End Function

Sub WriteToCell(r As Range)
    r.Value = GetText
    Dim location As Long: location = 1
    For i = 0 To UBound(colorTextArray) - 1
        With r.Characters(location, Len(colorTextArray(i).TextPart)).Font
            .color = colorTextArray(i).ColorPart
            .Strikethrough = colorTextArray(i).Strikethrough
        End With
        location = location + Len(colorTextArray(i).TextPart)
    Next
End Sub

次に標準モジュールを挿入する。モジュール名は任意。
コードは以下のとおり。

Option Explicit
Type State
    Strikethrough As Boolean
    InsertPoint As Boolean
    Replaced As Boolean
End Type

Type StatefulChar
    Text As String
    State As State
End Type

Private CellText() As StatefulChar

Const OriginalWordColor As Long = 3289800
Const CorrectedWordColor As Long = 13120050

Sub CorrectWord( _
    target_range As Range, _
    original_word As String, _
    Optional corrected_word As String = "")
    
    Dim r As Range: Set r = Selection
    
    '以下でCellTextを実際の文字数よりも1つ多く確保しているのは、
    '空白セルを選んだときにインデックスエラーを回避するのと、
    'セルの内容が置換対象文字そのものだった場合に文字単位の
    'ヒットカウント(charPointer)が上手く機能しないトラブルを
    '回避するための苦肉の策。
    'なお、多めに確保したCellTextは中身が初期状態(vbNullString)
    'なので動作に悪影響を与えない。
    ReDim CellText(1 To Len(r.Value) + 1)
    
    '文字ごとにステータスを登録するフェーズ
    Dim i As Long
    For i = 1 To Len(r.Value)
        CellText(i).Text = Mid(r.Value, i, 1)
        CellText(i).State.Strikethrough = r.Characters(i, 1).Font.Strikethrough
        CellText(i).State.Replaced = r.Characters(i, 1).Font.color = CorrectedWordColor
    Next
    
    'original_wordの一致を一文字ずつ探すフェーズ
    Dim charPointer As Long: charPointer = 1
    Dim charLocationStore As Collection: Set charLocationStore = New Collection
    Dim n As Long: n = 1
    Do While n < UBound(CellText)
        If Not CellText(n).State.Strikethrough Then
            If Mid(original_word, charPointer, 1) = CellText(n).Text Then
                charPointer = charPointer + 1
                charLocationStore.Add n
            Else
                charPointer = 1
                Set charLocationStore = New Collection
            End If
            If charPointer > Len(original_word) Then
                Dim t
                For Each t In charLocationStore
                    CellText(t).State.Strikethrough = True
                Next
                CellText(n).State.InsertPoint = True
            End If
        End If
        n = n + 1
    Loop
    
    'セルに出力するためにColorfulStringObjectを構築するフェーズ
    Dim CSO As ColorfulStringObject: Set CSO = New ColorfulStringObject
    Dim j As Long
    For j = LBound(CellText) To UBound(CellText)
        Dim col As XlRgbColor
        If CellText(j).State.Strikethrough Then
            col = OriginalWordColor
        ElseIf CellText(j).State.Replaced Then
            col = CorrectedWordColor
        Else
            col = rgbBlack
        End If
        CSO.AddText CellText(j).Text, col, CellText(j).State.Strikethrough
        If CellText(j).State.InsertPoint Then
            CSO.AddText corrected_word, CorrectedWordColor, False
        End If
    Next
    
    '一気にセル書き出し
    CSO.WriteToCell target_range
End Sub

ちょっとこのプロシージャは長すぎるけど、まぁ今回は動いたところまでで満足したので良しとしよう。

最後に任意のモジュールに以下のコードを挿入する。

Sub CorrectTest()
    Call CorrectWord(Selection, "ばなな", "バナナ")
    Call CorrectWord(Selection, "おやつに入りません", "おやつに入ります")
End Sub

実行

「ばななはおやつに入りません。いいですか？ばななは、ですよ？」という文言が書かれたセルを選択した状態で、CorrectTestを実行すると、2回の編集が適用されて以下のように表示が変わる。

おまけ1 思考のプロセス

最初のデータ構造を考えるときに書いたメモ。赤字はブログ掲載したときに意味が分かるように追記したもの。

頭の中だけでは思考が破綻するので、データ構造で悩んだら適当に紙に書いてみたり、パワポのスマートアートでツリー作ってみたりと裏で色々ごにょごにょしてます。

おまけ2 破綻したアイデア

文字列をチャンクに分けて管理するということも考えた。

ただ結局チャンクを跨いで置換が発生するケースに対応できないと気付いて破綻。

しかしこの気付きのおかげで標準のReplace関数を捨てて自前で置換を実装することを決断。この判断は正しかったと思う。
コード中では自前で置換するための文字を消し込む位置の保持にcharLocationStoreコレクションを使っている。
一度消し込んだ文字にヒットさせないために、そうでない文字のロケーションだけがcharLocationStoreに貯めこまれる仕組み。

以上

VBA 循環的複雑度という指標でプロシージャの複雑度を測ってみる

VBAに限らずすべての言語に言えることだが、プロシージャが複雑になればなるほどバグが混入しやすくなる。

そこで今回はプロシージャの複雑度を測る「循環的複雑度」という指標を紹介する。
何がどう循環的なのか知らないけど、名前が醸し出すややこしさとは反対に、とてもシンプルに計算できるので身構える必要はない。

まず押さえておきたいのは、この指標は10以下が理想的で、30を超えるとヤバいということ。

数え方

以下の参考サイトに次の表記がある。

関数の循環的複雑度　= 1 + 関数の中に以下のものが出てきた回数：
if、while、for、foreach、case、default、continue、goto、&&、||、catch、?: (三項演算子)、??

参考：D.O.R.Y. : Dory Offers a Room for You: 循環的複雑度 ( Cyclomatic Complexity ) とは何ぞや

つまりこれをVBAの用語に翻訳すると、

プロシージャの循環的複雑度　= 1 + プロシージャの中に以下のものが出てきた回数：
If、ElseIf、Do、For、For Each、Case、GoTo、And、Or、Wend、IIf、Switch、Choose

ということになる。

※WhileではなくWendとしたのは、Do文のWhileキーワードと、While～Wend文のWhileキーワードが別物だから。
※Caseは、Select Case文の中身のCaseだけ数える。Selectキーワードの直後に来るCaseはノーカウント。

抜け漏れがあるかもしれないけど、主だったものは概ねカバーできてるはず。

勘違いしやすいポイントだが、Elseはカウントしない。
なぜならElseが明示的に書かれようと書かれまいと、分岐経路の数は変わらないから。

※ElseIfは別途経路が発生するのでカウントする。

ForやDoなどの繰り返しも、終了条件を満たしたらスキップされるという点で、分岐処理の一種といえる。
イメージしにくければ、最初から終了条件を満たしていればループの内部は一切通らないという点を考えてみると良い。

AndやOrは条件を集約しているが、以下のように分解して考えると経路の分岐にカウントされる理由が分かると思う。

↓Andの場合

'元のコード
If A And B Then
    Result1
Else
    Result2
End If

'条件を分解したコード
If A Then
    If B Then
         Result1
    Else
         Result2
    End If
End If

↓Orの場合

'元のコード
If A Or B Then
    Result1
Else
    Result2
End If

'条件を分解したコード
If A Then
    Result1
ElseIf B Then
    Result1
Else
    Result2
End If

具体例

今私が作ってるマクロのプロシージャを例に循環的複雑度を測ってみる。
コードはこちら。

Sub ChangeProcessType(TargetShape As Shape, T As MsoAutoShapeType)
    Dim processConnectors As New Collection
    Dim s As Shape
    
    '現在TargetShapeに接続されたコネクタを一覧化しておく
    For Each s In TargetShape.Parent.Shapes
        If s.Connector Then
            If s.ConnectorFormat.BeginConnected Then
                If s.ConnectorFormat.BeginConnectedShape Is TargetShape Then
                    processConnectors.Add _
                        Array(s, s.ConnectorFormat.BeginConnectionSite, True) 'True=Begin
                End If
            End If
            If s.ConnectorFormat.EndConnected Then
                If s.ConnectorFormat.EndConnectedShape Is TargetShape Then
                    processConnectors.Add _
                        Array(s, s.ConnectorFormat.EndConnectionSite, False) 'False=End
                End If
            End If
        End If
    Next
    
    'シェイプタイプを切り替える。
    TargetShape.AutoShapeType = T
    'このとき、コネクタの接続が外れる
    
    '一覧に登録されたコネクタをTargetShapeに再接続する
    Dim c As Variant
    For Each c In processConnectors
        Dim processConnector As Shape: Set processConnector = c(0)
        If c(2) Then 'True=Begin, False=End
            processConnector.ConnectorFormat.BeginConnect TargetShape, c(1)
        Else
            processConnector.ConnectorFormat.EndConnect TargetShape, c(1)
        End If
    Next
End Sub

赤丸をつけて数えてみると、該当するものが8個。

初期値が1なので、1+8 = 9
循環的複雑度は9という結果になった。
10未満なのでこのプロシージャの複雑度は、まずまず良好と言える。

参考

複雑度の指標
szk-takanori.hatenablog.com

複雑度の計算方法
saturday-dory-fever.blogspot.com

ちなみにRubberduckというVBEのアドインを使うと、循環的複雑度(Cycromatic Complexity)を自動的に計測してくれる。
Rubberduckは導入するとVBエディタの初回起動がもたつくのと、そもそもPCスペックがそれなりにないと重たいのと、すべて英語なのと、設計思想が本業プログラマー寄りなので、万人にオススメできるものではない。
でもとても便利なツールなので興味があれば導入してみると良いかもしれない。

VBA マージソートの為に配列を左右に分ける計算式の妥当性を検証する方法

今回すんごいスコープを絞ったタイトルにしたけど、それには訳がある。

このブログで過去にマージソートのコードを紹介した。
thom.hateblo.jp

その際コードを作るのにとても苦労したので、もう少し配列を抽象的に扱えるクラスを作って楽にマージソートしようと思い立った。
ただ、クラスを作るにあたってもやはり苦労するポイントが同じなので、今回は改めて計算式を再考し、その妥当性を検証しようという記事である。

具体的に苦労したのは、配列を二つに分けるパート。
たとえば配列の最小値が0で最大値が10のとき、要素数は11個ある。

これをなるべく均等に分けると、5個と6個になる。

配列のインデックスでいうと、0～4と、5～10である。

つまり0, 10という配列インデックスから、分割された0, 4, 5, 10という4つのインデックスを導き出す必要があるのだが、実は私、こういう計算が大の苦手。
そもそもインデックスが2～10だったら？とか、奇数と偶数でパターンは大丈夫か？とか、とにかく頭の中で成功イメージが湧かずに心配になる。

そこで、その計算の検証をシート上で目に見える形でやった。
普段これは裏方作業なので記事になることは無いのだが、こういう思考プロセスも何かしら参考になるんじゃないかと思って見せることにした。

ただそれを記事にしたらもうそれだけで疲れてしまって、マージソート完成まで書ききる気力は無いだろうなと思って今回はスコープを絞ることにした。

案の定、最近記事執筆ペースが落ちている私は、ここまでの前書きだけでひぃひぃ言っている。

さて、イメージした検証はこんな感じ。

1. シート上に手動で0～10のインデックスヘッダーを用意しておく(濃い黄色)
2. マクロで配列の最小インデックスから最大インデックスまでを塗る(薄い黄色)
3. マクロで中間点に"Split Here"を書き込む
4. 目視で「ああ、ちゃんと半分に割れてるね」を確認する

本当は配列を作ってLBoundやUBoundで試すんだけれど、今回は計算式の妥当性検証なので変数lbとubで代用。

まず計算式を考えてみる。

半分に分けるためには、まず要素数を求める必要がある。
要素数はインデックスの最大値(変数 ub)から、インデックスの最小値(変数 lb)を引いて、1を足せば求まる。

要素数 = ub - lb + 1

例えば配列のインデックスが0 ～ 10に当てはめると、
10 - 0 + 1 = 11個

例えば配列のインデックスが2 ～ 10に当てはめると、
10 - 2 + 1 = 9個

確かに合ってる。

これを何個と何個に分けるかの計算は分割された配列の前半の個数を求めれば良いので、2で割って余りを切り捨てれば良い。

前半の個数 = 要素数 \ 2
※ブログのフォントでバックスラッシュに見えるものは、円マークです。これは割り算ですが、計算結果として整数を返します。

つまり最初の式と混ぜるとこうなる。
前半の個数 = (ub - lb + 1) \ 2

そして前半の個数を前半のインデックスの終値に変換するには。。。

たとえばインデックス0から始まる場合で5個の要素を取り出すと0, 1, 2, 3, 4 で終値が4。
インデックスが2で5個なら、2, 3, 4, 5, 6 で6。

計算式は
前半のインデックス終値 = 開始インデックス + 前半の個数 - 1
が成り立ってるっぽい。

インデックスがマイナス開始だったらどうか。
開始値が-1の場合、-1, 0, 1, 2, 3。 計算すると、 -1 + 5 - 1 = 3。
あってる。

混乱するのはこのあたり。なんで？って言われても知らない。
複数ケースに当てはめてちゃんと成り立つのでとしか。。

また先ほどの式と混ぜると、こうなる。
前半のインデックス終値 = lb + ((ub - lb + 1) \ 2) - 1

ちなみに要素数が1つしかない場合はインデックス終値がlbより小さくなってしまうが、もともと分割できないのでこれは仕方ない。

あとはlbとubを変化させながらこの式を使ってシート上にどこで分割するかを表示させていく。

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

Sub 実験()
    Dim lb, ub
    Dim 行: 行 = 2
    Const 列Offset = 1
    For lb = 0 To 10
        For ub = lb To lb + 10
            Range(Cells(行, lb + 列Offset), Cells(行, ub + 列Offset)).Interior.Color = rgbLightYellow
            If ub - lb + 1 > 1 Then
                Cells(行, lb + ((ub - lb + 1) \ 2) - 1 + 列Offset).Value = "SplitHere"
            End If
            行 = 行 + 1
        Next
    Next
End Sub

実行結果はこうなる。

目視で確認してみても、問題なく半分に割れてそう。

広域を確認してみる。

よし、イケる。この式だ！

ということで、最終的に以下の式の妥当性が検証された。
前半のインデックス終値 = lb + ((ub - lb + 1) \ 2) - 1

配列分割にあたって求めるべき全体はこうなる。

前半のインデックス始値：lb
前半のインデックス終値：lb + ((ub - lb + 1) \ 2) - 1
後半のインデックス始値：前半のインデックス終値 + 1
後半のインデックス終値：ub

実態

配列インデックス関連の計算は考えてると頭がこんがらがって思考が破綻するので実際に実験してみるという方法で攻略することが多い。

今回は記事を書くにあたって改めて論理的に計算式を思考してみたけれど普段はそんなことしてなくて、lbとubを使って「だいたいこうかな？」って勘で計算式を作ってみて、こうやってシート上でざくっと表示させてみる。それで目視でうまくいってたらその式を使うという割と雑なことをしている。

要は、理屈は分からんけどうまくうごいた！という極めて信頼性の低い根拠でも、充分なテスト量を確保することによって統計的な信頼性を確保するという手法。

ちなみに前回マージソートをやったときの前半のインデックス計算式は実質lb + ((ub - lb) \2)というかなりザックリしたもの。
でもシート上で実際に試してみると、今回の式と位置は微妙に違うけどちゃんと半分に割れてる。
5:6で割るところが6:5になったり、違いといえばそれくらい。全く問題ない。

考えてみればlb + ((ub - lb + 1) \ 2) - 1って、赤字の+1が2で割られるから+0.5、外の青字の1と相殺されて-0.5なので、インデックスを半分に分けるという目的においては、誤差の範囲に収まる。だからlb + ((ub - lb) \2)で問題ないんだな。

VBA TRANSPOSE関数で一次元データのみの二次元配列を一次元配列に変換する。

VBAでは、セル範囲と配列の相互変換ができるが、たとえ1列分しか変換しなくても二次元配列となってしまう。

参考
infoment.hatenablog.com

VBAのJoin関数でひとつの文字列に加工しようと思ったら色々と工夫が必要なのだが、実はワークシート関数のTRANSPOSEを使うと簡単にできるという裏技がある。

たとえば次のようなデータを用意する。

これを二次元配列arrとして読み込み、Transpose関数を使って一次元配列arr2を作る。あとはJoinするだけ。

Sub 一次元データのみの二次元配列のJoin()
    Dim arr: arr = Range("A1:A3")
    Dim arr2: arr2 = WorksheetFunction.Transpose(arr)
    MsgBox Join(arr2, vbNewLine)
End Sub

次に行データだったらどうするか。

そのままではうまくいかないので、Transposeを2回かませて列データに変更する。

Sub 一次元データのみの二次元配列のJoin_行バージョン()
    Dim arr: arr = Range("A1:C1")
    Dim arr2: arr2 = WorksheetFunction.Transpose(arr)
    Dim arr3: arr3 = WorksheetFunction.Transpose(arr2)
    MsgBox Join(arr3, vbNewLine)
End Sub

参考

この事実を教えてくれたのはこちらのサイト。感謝。
配列研究室 STEP 3

上記サイトではEvaluate関数の短縮表記である[]を使って更に短く書いている。
今回のケースに適用すると、以下のとおり。

Sub 一次元データのみの二次元配列のJoin_行バージョン()
    MsgBox Join([TRANSPOSE(TRANSPOSE(A1:C1))], vbNewLine)
End Sub

ただこれだとセル範囲がベタ書きになってしまうので、ThisWorkbookからRangeまで確実に指定したい時に応用が利かない。
※↓こう書きたい場合のこと

Sub 一次元データのみの二次元配列のJoin_行バージョン()
    Dim arr: arr = ThisWorkbook.Sheets(1).Range("A1:C1")
    Dim arr2: arr2 = WorksheetFunction.Transpose(arr)
    Dim arr3: arr3 = WorksheetFunction.Transpose(arr2)
    MsgBox Join(arr3, vbNewLine)
End Sub

[]を使わずに少し短くしようと思ったら、こうかな？

Sub 一次元データのみの二次元配列のJoin_行バージョン()
    Dim arr: arr = ThisWorkbook.Sheets(1).Range("A1:C1")
    With WorksheetFunction
        MsgBox Join(.Transpose(.Transpose(arr)))
    End With
End Sub

8/3 余談追記

この記事でリンクした「配列研究室 STEP 3」はExcel研究室の一角だった。
www.clayhouse.jp

しかも結構濃い目の書籍を出版されている土屋さんのサイトだった。
感謝の意を込めていくつか紹介させていただく。

こちらは今となっては珍しいWord VBA本。

最速攻略 Word マクロ / VBA徹底入門 〔Word 2013/2010/2007対応版〕

こちらは残念ながら絶版してるけど、Evaluateの短縮表記[]はこの書籍で覚えた。イミディエイトウインドウを活用した即席1行コードが沢山紹介されている希少本。

EXCEL VBA 1行コード活用辞典 (CD-ROM付き)

こちらはExcelの配列を扱った専門書。VBAではなくてExcelの配列数式ってのがポイント。

すぐわかるSUPER Excel配列マジックを極める 営業、経理、総務もこれでExcelマスター! 面倒な集計や計算処理が格段に楽になる! (すぐわかるシリーズ)

こちらは2016年発刊なので比較的最近の本。
上の3点に比べるとクセのない王道的なVBA本かなと思う。

今すぐ使えるかんたんEx Excelマクロ&VBA プロ技 BESTセレクション [Excel 2016/2013/2010/2007対応版]

以上。